Added exception handling, an autorestart when that happens and output in case of restart/reload

4 files changed, 32 insertions, 24 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index eacbe63..49f5f5d 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -70,10 +70,10 @@ runHsbot = do
             config   = envConfig env
             nickname = head $ configNicknames config
             channels = configChannels config
-        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.nick nickname
-        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
+        liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.nick nickname
+        liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
         -- Then we join channels
-        mapM_ (liftIO . sendStr connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
+        mapM_ (liftIO . sendStr env connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
         -- Finally we set the new bot state
         asks envBotState >>= liftIO . flip putMVar BotState { botPlugins  = M.empty
                                                             , botAccess   = configAccess config
@@ -88,9 +88,8 @@ runHsbot = do
         liftIO $ debugM "Hsbot.Core" "Spawning reader thread"
         let connhdl  = envHandle env
             tlsCtx   = envTLSCtx env
-        myOwnThreadId  <- liftIO myThreadId
         chan <- asks envChan
-        (liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= addThreadIdToQuitMVar
+        (liftIO . forkIO $ botReader env connhdl tlsCtx chan) >>= addThreadIdToQuitMVar
         -- Then we spawn all plugins
         asks envConfig >>= mapM_ loadPlugin . configPlugins
         -- Finally we spawn the main bot loop
@@ -102,18 +101,18 @@ runHsbot = do
         -- TODO : kill plugin threads
         return code
 
-botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
-botReader _ (Just ctx) chan _ = forever $
-    fmap L.toString (recvData ctx) >>= handleIncomingStr chan  -- TODO exceptions
-botReader handle Nothing chan fatherThreadId = forever $
-    hGetLine handle `catch` handleIOException >>= handleIncomingStr chan
-  where
-    handleIOException :: IOException -> IO String
-    handleIOException ioException = do
-        throwTo fatherThreadId ioException
-        myId <- myThreadId
-        killThread myId
-        return ""
+botReader :: BotEnv -> Handle -> Maybe TLSCtx -> Chan Message -> IO ()
+botReader env _ (Just ctx) chan = forever $
+    fmap L.toString (recvData ctx) `catch` handleIOException env  "botReader died" >>= handleIncomingStr chan
+botReader env handle Nothing chan = forever $
+    hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
+
+handleIOException :: BotEnv -> String -> IOException -> IO String
+handleIOException env msg ioException = do
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+    myId <- myThreadId
+    killThread myId
+    return ""
 
 handleIncomingStr :: Chan Message -> String -> IO ()
 handleIncomingStr chan str =
@@ -136,7 +135,7 @@ botLoop = forever $ do
             let connhdl  = envHandle env
                 tlsCtx   = envTLSCtx env
             liftIO $ debugM "Hsbot.Loop" $ "--> " ++ show outMsg
-            liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
+            liftIO . sendStr env connhdl tlsCtx $ IRC.encode outMsg
 
 terminateHsbot :: Env IO ()
 terminateHsbot = do
diff --git a/Hsbot/Plugin/Admin.hs b/Hsbot/Plugin/Admin.hs
index 7dba362..cbec152 100644
--- a/Hsbot/Plugin/Admin.hs
+++ b/Hsbot/Plugin/Admin.hs
@@ -33,11 +33,11 @@ theAdmin = forever $ readMsg >>= eval
                         else answerMsg msg "Only admins can do that."
                 "restart":"help":_ -> answerMsg msg "restart hsbot, reset the running state to config file directives."
                 "restart":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
-                        then lift $ setGlobalQuitMVar BotRestart
+                        then lift . setGlobalQuitMVar $ BotRestart (getSender msg ++ " request", Nothing)
                         else answerMsg msg "Only admins can do that."
                 "reload":"help":_ -> answerMsg msg "reload hsbot, and try merge the new config file directives with actual running state)."
                 "reload":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
-                        then lift $ setGlobalQuitMVar BotReload
+                        then lift . setGlobalQuitMVar . BotReload $ getSender msg ++ " request"
                         else answerMsg msg "Only admins can do that."
                 _ -> return ()
         | otherwise = return ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 8f84482..7ca9ee0 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -66,7 +66,7 @@ data PluginId = PluginId
 data Message = IncomingMsg IRC.Message
              | OutgoingMsg IRC.Message
 
-data BotStatus = BotContinue | BotExit | BotReload | BotRestart deriving (Show)
+data BotStatus = BotExit | BotReload String | BotRestart (String, Maybe String) deriving (Read, Show)
 
 -- Config
 data Config = Config
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 2a8f58c..043037d 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -8,12 +8,14 @@ module Hsbot.Utils
     ) where
 
 import Control.Concurrent
+import Control.Exception (IOException, catch)
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.ByteString.Lazy.UTF8 as L
 import qualified Data.List as L
 import qualified Network.IRC as IRC
 import Network.TLS
+import Prelude hiding (catch)
 import System.IO
 
 import Hsbot.Types
@@ -47,9 +49,16 @@ hasAccess (Just mask) right = do
       | otherwise = False
 
 -- Helpers
-sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
-sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
-sendStr handle Nothing msg = hPutStrLn handle $ msg ++ "\r\n"
+sendStr :: BotEnv -> Handle -> Maybe TLSCtx -> String -> IO ()
+sendStr env _ (Just ctx) msg = sendData ctx (L.fromString $ msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
+sendStr env handle Nothing msg = hPutStrLn handle (msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
+
+handleIOException :: BotEnv -> String -> IOException -> IO ()
+handleIOException env msg ioException = do
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+    myId <- myThreadId
+    killThread myId
+    return ()
 
 -- TLS utils
 initTLSEnv :: TLSConfig -> IO TLSParams