Add logging

Also fix reconnecting logic
This commit is contained in:
Joscha 2018-02-16 12:47:18 +00:00
parent 6ba2ddfaea
commit 5a75d9b205
3 changed files with 52 additions and 47 deletions

View file

@ -36,6 +36,7 @@ dependencies:
- unordered-containers - unordered-containers
# other # other
- stm - stm
- hslogger
library: library:
source-dirs: src source-dirs: src

View file

@ -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
-}

View file

@ -1,3 +1,10 @@
import System.IO
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.Bot as E
import qualified EuphApi.Connection as E import qualified EuphApi.Connection as E
@ -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