Add logging
Also fix reconnecting logic
This commit is contained in:
parent
6ba2ddfaea
commit
5a75d9b205
3 changed files with 52 additions and 47 deletions
|
|
@ -36,6 +36,7 @@ dependencies:
|
||||||
- unordered-containers
|
- unordered-containers
|
||||||
# other
|
# other
|
||||||
- stm
|
- stm
|
||||||
|
- hslogger
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|
|
||||||
|
|
@ -20,11 +20,32 @@ import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import qualified Data.Text as T
|
|
||||||
import Control.Monad.Trans.Reader
|
import Control.Monad.Trans.Reader
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified System.Log.Logger as L
|
||||||
|
|
||||||
import qualified EuphApi.Connection as E
|
import qualified EuphApi.Connection as E
|
||||||
|
|
||||||
|
-- logging functions
|
||||||
|
moduleName :: String
|
||||||
|
moduleName = "EuphApi.Bot"
|
||||||
|
debugM :: String -> IO ()
|
||||||
|
debugM = L.debugM moduleName
|
||||||
|
infoM :: String -> IO ()
|
||||||
|
infoM = L.infoM moduleName
|
||||||
|
noticeM :: String -> IO ()
|
||||||
|
noticeM = L.noticeM moduleName
|
||||||
|
--warningM :: String -> IO ()
|
||||||
|
--warningM = L.warningM moduleName
|
||||||
|
--errorM :: String -> IO ()
|
||||||
|
--errorM = L.errorM moduleName
|
||||||
|
--criticalM :: String -> IO ()
|
||||||
|
--criticalM = L.criticalM moduleName
|
||||||
|
--alertM :: String -> IO ()
|
||||||
|
--alertM = L.alertM moduleName
|
||||||
|
--emergencyM :: String -> IO ()
|
||||||
|
--emergencyM = L.emergencyM moduleName
|
||||||
|
|
||||||
data BotState b c = BotState
|
data BotState b c = BotState
|
||||||
{ bAddress :: TVar String
|
{ bAddress :: TVar String
|
||||||
, bRoom :: TVar String
|
, bRoom :: TVar String
|
||||||
|
|
@ -83,6 +104,7 @@ runBot BotConfig{..} = do
|
||||||
bPassword <- atomically $ newTVar $ T.pack <$> botPassword
|
bPassword <- atomically $ newTVar $ T.pack <$> botPassword
|
||||||
bNick <- atomically $ newTVar $ T.pack botNick
|
bNick <- atomically $ newTVar $ T.pack botNick
|
||||||
bStopping <- atomically $ newTVar False
|
bStopping <- atomically $ newTVar False
|
||||||
|
noticeM $ "Connecting to &" ++ botRoom ++ " on " ++ show botAddress ++ "."
|
||||||
bConnection <- E.startEuphConnection botAddress botRoom
|
bConnection <- E.startEuphConnection botAddress botRoom
|
||||||
bConnectionInfo <- botNewConnectionInfo
|
bConnectionInfo <- botNewConnectionInfo
|
||||||
let bHandler = botHandler
|
let bHandler = botHandler
|
||||||
|
|
@ -90,7 +112,7 @@ runBot BotConfig{..} = do
|
||||||
bNewConnectionInfo = botNewConnectionInfo
|
bNewConnectionInfo = botNewConnectionInfo
|
||||||
bReconnectPolicy = botReconnectPolicy
|
bReconnectPolicy = botReconnectPolicy
|
||||||
state = BotState{..}
|
state = BotState{..}
|
||||||
runReaderT eventLoop state
|
runReaderT (eventLoop 0) state
|
||||||
|
|
||||||
reconnect :: Integer -> Bot b c ()
|
reconnect :: Integer -> Bot b c ()
|
||||||
reconnect retries = do
|
reconnect retries = do
|
||||||
|
|
@ -102,28 +124,32 @@ reconnect retries = do
|
||||||
case (bReconnectPolicy state $ retries) of
|
case (bReconnectPolicy state $ retries) of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just delay -> do
|
Just delay -> do
|
||||||
|
liftIO $ infoM $ "Attempting reconnect in " ++ show (delay `div` 1000000)
|
||||||
|
++ "s (" ++ show delay ++ "µs)."
|
||||||
liftIO $ threadDelay delay
|
liftIO $ threadDelay delay
|
||||||
address <- liftIO $ atomically $ readTVar $ bAddress state
|
address <- liftIO $ atomically $ readTVar $ bAddress state
|
||||||
room <- liftIO $ atomically $ readTVar $ bRoom state
|
room <- liftIO $ atomically $ readTVar $ bRoom state
|
||||||
con <- liftIO $ E.startEuphConnection address room
|
con <- liftIO $ E.startEuphConnection address room
|
||||||
|
liftIO $ infoM $ "Reconnecting to &" ++ room ++ " on " ++ show address ++ "."
|
||||||
conInfo <- liftIO $ bNewConnectionInfo state
|
conInfo <- liftIO $ bNewConnectionInfo state
|
||||||
let newState = state{bConnection=con, bConnectionInfo=conInfo}
|
let newState = state{bConnection=con, bConnectionInfo=conInfo}
|
||||||
local (const newState) eventLoop
|
local (const newState) (eventLoop retries)
|
||||||
-- lift $ runReaderT eventLoop newState
|
-- lift $ runReaderT (eventLoop retries) newState
|
||||||
|
|
||||||
eventLoop :: Bot b c ()
|
eventLoop :: Integer -> Bot b c ()
|
||||||
eventLoop = do
|
eventLoop retries = do
|
||||||
con <- getConnection
|
con <- getConnection
|
||||||
handler <- asks bHandler
|
handler <- asks bHandler
|
||||||
event <- liftIO $ E.getEvent con
|
event <- liftIO $ E.getEvent con
|
||||||
|
liftIO $ debugM $ "Received event: " ++ show event
|
||||||
handler event
|
handler event
|
||||||
case event of
|
case event of
|
||||||
E.ConnectionFailed -> reconnect 0
|
E.ConnectionFailed -> reconnect (retries + 1)
|
||||||
E.Disconnected -> reconnect 0
|
E.Disconnected -> reconnect 0
|
||||||
E.EuphEvent e -> do
|
E.EuphEvent e -> do
|
||||||
handlePasswordStuff e
|
handlePasswordStuff e
|
||||||
handleNickStuff e
|
handleNickStuff e
|
||||||
eventLoop
|
eventLoop retries
|
||||||
|
|
||||||
handleNickStuff :: E.Event -> Bot b c ()
|
handleNickStuff :: E.Event -> Bot b c ()
|
||||||
handleNickStuff (E.SnapshotEvent _ _ _ maybeNick) = do
|
handleNickStuff (E.SnapshotEvent _ _ _ maybeNick) = do
|
||||||
|
|
@ -149,38 +175,3 @@ handlePasswordStuff (E.BounceEvent _ (Just options))
|
||||||
Just p -> fork $ liftIO $ E.auth con p
|
Just p -> fork $ liftIO $ E.auth con p
|
||||||
| otherwise = return ()
|
| otherwise = return ()
|
||||||
handlePasswordStuff _ = return ()
|
handlePasswordStuff _ = return ()
|
||||||
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
|
|
||||||
-- BOT EXAMPLE
|
|
||||||
{-
|
|
||||||
data MyConSpec = MyConSpec
|
|
||||||
{ mySessionView :: TVar E.SessionView
|
|
||||||
, myListing :: TVar E.Listing
|
|
||||||
, myArchive :: TVar E.Archive
|
|
||||||
}
|
|
||||||
|
|
||||||
instance ConSpecific MyConSpec where
|
|
||||||
newConSpecific = do
|
|
||||||
mySessionView <- newTVar empty
|
|
||||||
myListing <- newTVar empty
|
|
||||||
myArchive <- newTVar empty
|
|
||||||
return MyConSpec{..}
|
|
||||||
|
|
||||||
myBotConfig :: BotConfig
|
|
||||||
myBotConfig = defaultBotConfig{botNick="MyTestBot", botHandler=myHandler}
|
|
||||||
|
|
||||||
myHandler :: E.Event -> Bot () MyConSpec ()
|
|
||||||
myHandler e = undefined $ do
|
|
||||||
conSpec <- getConSpecific
|
|
||||||
upateOwnView e (mySessionView conSpec)
|
|
||||||
upateListing e (myListing conSpec)
|
|
||||||
upateArchive e (myArchive conSpec)
|
|
||||||
withEuphEvent e handleEuphEvent
|
|
||||||
-}
|
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,12 @@
|
||||||
import qualified EuphApi.Bot as E
|
import System.IO
|
||||||
import qualified EuphApi.Connection as E
|
|
||||||
|
import qualified System.Log.Formatter as LF
|
||||||
|
import qualified System.Log.Handler as LH
|
||||||
|
import qualified System.Log.Handler.Simple as LH
|
||||||
|
import qualified System.Log.Logger as L
|
||||||
|
|
||||||
|
import qualified EuphApi.Bot as E
|
||||||
|
import qualified EuphApi.Connection as E
|
||||||
|
|
||||||
myBotConfig :: E.BotConfig () ()
|
myBotConfig :: E.BotConfig () ()
|
||||||
myBotConfig = E.BotConfig
|
myBotConfig = E.BotConfig
|
||||||
|
|
@ -13,4 +20,10 @@ myBotConfig = E.BotConfig
|
||||||
, E.botReconnectPolicy = E.defaultReconnectPolicy
|
, E.botReconnectPolicy = E.defaultReconnectPolicy
|
||||||
}
|
}
|
||||||
|
|
||||||
main = E.runBot myBotConfig
|
main = do
|
||||||
|
myHandler <- LH.verboseStreamHandler stderr L.INFO
|
||||||
|
let myFormatter = LF.simpleLogFormatter "<$time> [$loggername/$prio] $msg"
|
||||||
|
myFormattedHandler = LH.setFormatter myHandler myFormatter
|
||||||
|
L.updateGlobalLogger L.rootLoggerName (L.setHandlers [myFormattedHandler])
|
||||||
|
L.updateGlobalLogger L.rootLoggerName (L.setLevel L.INFO)
|
||||||
|
E.runBot myBotConfig
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue