From 066b27151074536d5598c8aedde5dc952c77ad68 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Sun, 5 Jun 2011 01:12:46 +0200
Subject: Simplified and greatly improved scoring for the duck game.

---
 Hsbot/Plugin/Duck.hs | 61 ++++++++++++++++++++--------------------------------
 1 file changed, 23 insertions(+), 38 deletions(-)

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 187c62d..4b05982 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -22,46 +22,29 @@ import Hsbot.Message
 import Hsbot.Types
 import Hsbot.Utils
 
--- | A user statistic
-data Stat = Stat
-    { statRounds :: Int
-    , statShot   :: Int
-    , statKilled :: Int
-    } deriving (Show, Typeable)
-
--- | Default values for new stat
-emptyStat :: Stat
-emptyStat = Stat { statRounds = 0
-                 , statShot   = 0
-                 , statKilled = 0 }
-
 -- The statistics database
 data StatDB = StatDB
-    { nickStats :: M.Map String Stat
+    { nickStats :: M.Map String Int
     } deriving (Show, Typeable)
 
 -- | Statistics database initial state
 emptyStatDB :: StatDB
 emptyStatDB = StatDB { nickStats = M.empty }
 
-$(deriveSafeCopy 0 'base ''Stat)
 $(deriveSafeCopy 0 'base ''StatDB)
 
 -- | Statistics database transactions
-scoreAction :: String -> Int -> Int -> Int -> Update StatDB ()
-scoreAction sender rounds shots kills = do
+updateScore :: String -> Int -> Update StatDB ()
+updateScore sender score = do
     statDB <- get
     let stats = nickStats statDB
-        stat = fromMaybe emptyStat $ M.lookup sender stats
-        stat' = stat { statRounds = rounds + statRounds stat
-                     , statShot   = shots  + statShot   stat
-                     , statKilled = kills  + statKilled stat }
-    put statDB { nickStats = M.insert sender stat' stats }
+        stat = fromMaybe 0 $ M.lookup sender stats
+    put statDB { nickStats = M.insert sender (stat + score) stats }
 
 getDuckStats :: Query StatDB StatDB
 getDuckStats = ask
 
-$(makeAcidic ''StatDB ['getDuckStats, 'scoreAction])
+$(makeAcidic ''StatDB ['getDuckStats, 'updateScore])
 
 -- | The duck plugin identity
 duck :: PluginId
@@ -85,21 +68,19 @@ theDuck channel seconds = do
             -- First we kill the ducks that we find in the message
             let kills = howManyDucksInThere . concat $ IRC.msg_params msg
             when (kills /= "") $ answerMsg msg kills
-            -- Then we check if someone shot some duck
             when (getDestination msg == channel) $ do
+                -- Then we check if someone shot some duck
                 let shots = howManyBulletFiredInThere . concat $ IRC.msg_params msg
                 when (shots > 0) $ do
-                    _ <- update' statDB (ScoreAction (getSender msg) 0 shots 0)
-                    noDucksToShoot <- liftIO $ isEmptyMVar ducksMVar
-                    unless noDucksToShoot $ do
-                        ducksWaitingForDeath <- liftIO $ modifyMVar ducksMVar (\x -> return (x - shots, x))
-                        _ <- update' statDB (ScoreAction (getSender msg) 0 0 (min ducksWaitingForDeath shots))
-                        when (shots >= ducksWaitingForDeath) $ do
-                            _ <- liftIO $ takeMVar ducksMVar
-                            time <- liftIO $ readMVar timeMVar
-                            duckSpawner channel time ducksMVar
-                            _ <- update' statDB (ScoreAction (getSender msg) 1 0 0)
-                            return ()
+                    empty <- liftIO $ isEmptyMVar ducksMVar
+                    ducksWaitingForDeath <- if empty then return 0
+                                                     else liftIO $ modifyMVar ducksMVar (\x -> return (x - shots, x))
+                    _ <- update' statDB . UpdateScore (getSender msg) $ computeScore ducksWaitingForDeath shots
+                    when (and [ ducksWaitingForDeath > 0, shots >= ducksWaitingForDeath ]) $ do
+                        _ <- liftIO $ takeMVar ducksMVar
+                        time <- liftIO $ readMVar timeMVar
+                        duckSpawner channel time ducksMVar
+                    return ()
                 -- Finally we check if we received some command
                 cmdArgs <- lift $ getCommand msg
                 case cmdArgs of
@@ -113,6 +94,11 @@ theDuck channel seconds = do
                     _ -> return ()
         | otherwise = return ()
     eval _ _ _ _ = return ()
+    computeScore :: Int -> Int -> Int
+    computeScore ducksWaitingForDeath shots
+        | shots < ducksWaitingForDeath = shots - 1
+        | shots == ducksWaitingForDeath = shots + 1
+        | otherwise = negate shots
 
 -- | Spawns ducks on a channel, just waiting to be shot
 duckSpawner :: String -> Int -> MVar Int -> Plugin (Env IO) ()
@@ -162,9 +148,8 @@ printDuckStats channel statDB = do
     sendLine "Duck slaughter simulator - Hall of Fame"
     mapM_ (sendLine . buildLine) $ M.toList (nickStats statDB)
   where
-    buildLine :: (String, Stat) -> String
-    buildLine (nick, stat) = concat [ nick,  ": ", show $ statRounds stat, " rounds won, ", show $ statShot stat
-                                    , " shots fired, ", show $ statKilled stat, " ducks killed" ]
+    buildLine :: (String, Int) -> String
+    buildLine (nick, score) = concat [ nick,  ": ", show score ]
     sendLine :: String -> Plugin (Env IO) ()
     sendLine msg = writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [channel, msg]
 
-- 
cgit v1.2.3


From 336ec596894a41cb0fa55fd9e1a76f6f62c9364f Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 17 Jun 2011 13:07:25 +0200
Subject: Fixed a bug in command parsing

---
 Hsbot/Message.hs | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs
index 14488a1..a34659d 100644
--- a/Hsbot/Message.hs
+++ b/Hsbot/Message.hs
@@ -30,12 +30,15 @@ answerMsg _ _ = return ()
 
 -- | Get the command in the IRC message if there is one
 getCommand :: IRC.Message -> Env IO [String]
-getCommand (IRC.Message _ _ (_:msg:[])) = do
-    currentBotState <- asks envBotState >>= liftIO . readMVar
-    let cmd:stuff = if msg /= "" then words msg else ["",""]
-    if botNickname currentBotState `L.isPrefixOf` cmd
-        then return stuff
-        else return []
+getCommand (IRC.Message _ _ (_:msg:[])) = getCommandFrom $ words msg
+  where
+    getCommandFrom :: [String] -> Env IO [String]
+    getCommandFrom (cmd:stuff) = do
+        currentBotState <- asks envBotState >>= liftIO . readMVar
+        if botNickname currentBotState `L.isPrefixOf` cmd
+            then return stuff
+            else return []
+    getCommandFrom _ = return []
 getCommand _ = return []
 
 getSender :: IRC.Message -> String
-- 
cgit v1.2.3


From 8fae43453245bdc683e64957b9499423b8825e7b Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 17 Jun 2011 13:08:33 +0200
Subject: Improved the duck plugin arguments handling

---
 Hsbot/Plugin/Duck.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 4b05982..7ba2146 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE TypeFamilies, DeriveDataTypeable, TemplateHaskell #-}
 -- | This module is an IRC plugin that generates and kills ducks
 module Hsbot.Plugin.Duck
-    ( duck
+    ( DuckArgs (..)
+    , duck
     , theDuck
     ) where
 
@@ -50,11 +51,15 @@ $(makeAcidic ''StatDB ['getDuckStats, 'updateScore])
 duck :: PluginId
 duck = PluginId
     { pluginName = "duck"
-    , pluginEp   = theDuck "" 10 }
+    , pluginEp   = theDuck $ DuckArgs { duckChannel = "", duckFreq = 10 } }
+
+data DuckArgs = DuckArgs
+    { duckChannel :: String
+    , duckFreq    :: Int }
 
 -- | An IRC plugin that generates and kills ducks
-theDuck :: String -> Int -> Plugin (Env IO) ()
-theDuck channel seconds = do
+theDuck :: DuckArgs -> Plugin (Env IO) ()
+theDuck (DuckArgs channel seconds) = do
     baseDir <- liftIO $ System.Environment.XDG.BaseDir.getUserDataDir "hsbot"
     statDB <- liftIO $ openAcidStateFrom (baseDir ++ "/duckDB/") emptyStatDB
     ducksMVar <- liftIO newEmptyMVar
-- 
cgit v1.2.3


From 62a4220ce0c9b1b6c263a23f8871ab54dfe523a9 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 17 Jun 2011 13:09:09 +0200
Subject: Added some duck funny faces

---
 Hsbot/Plugin/Duck.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 7ba2146..946cb0c 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -141,7 +141,7 @@ ducks = [ x : y : z | x <- ">=", y <- face, z <- ["__/", "_/"] ]
      ++ [ L.reverse $ x : y : z | x <- "<=", y <- face, z <- ["__\\", "_\\"] ]
   where
     face :: String
-    face = "oO°@©®ð*òôóø⊕ΩꙫꙩꙨ◔"
+    face = "oO°@©®ð*òôóø⊕ΩꙫꙩꙨ◔ȯõ⁰"
 
 -- | Weapons can have different noises
 bangs :: [String]
-- 
cgit v1.2.3


From b666e543d0ae03f79ca8b8527c099ca6320f27b0 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 11 Jul 2011 22:35:41 +0200
Subject: Fixed TLS client implementation

---
 Hsbot/Config.hs |  6 +-----
 Hsbot/Core.hs   | 18 +++++++++---------
 Hsbot/Types.hs  |  2 --
 Hsbot/Utils.hs  | 59 ++++++---------------------------------------------------
 hsbot.cabal     |  3 ++-
 5 files changed, 18 insertions(+), 70 deletions(-)

diff --git a/Hsbot/Config.hs b/Hsbot/Config.hs
index d51387b..8c85810 100644
--- a/Hsbot/Config.hs
+++ b/Hsbot/Config.hs
@@ -24,12 +24,8 @@ defaultConfig = Config
 defaultTLSConfig :: TLSConfig
 defaultTLSConfig = TLSConfig
     { sslOn       = True
-    , sslCert     = ""
-    , sslKey      = ""
     , sslVersions = [SSL3, TLS10, TLS11, TLS12]
-    , sslCiphers  = [ cipher_null_MD5
-                    , cipher_null_SHA1
-                    , cipher_AES128_SHA1
+    , sslCiphers  = [ cipher_AES128_SHA1
                     , cipher_AES256_SHA1
                     , cipher_RC4_128_MD5
                     , cipher_RC4_128_SHA1
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 9c72771..11c8732 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -8,8 +8,7 @@ import Control.Concurrent
 import Control.Exception (IOException, catch)
 import Control.Monad.Reader
 import Crypto.Random
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.UTF8 as L
 import qualified Data.Map as M
 import Network
 import qualified Network.IRC as IRC
@@ -33,15 +32,16 @@ initHsbot config = do
         port = configPort config
     infoM "Hsbot.Core" $ "Connecting to " ++ hostname -- ++ ":" ++ port
     connhdl <- connectTo hostname port
-    hSetBuffering connhdl LineBuffering
+    hSetBuffering connhdl NoBuffering
     hSetEncoding connhdl utf8
     (tls, tlsCtx) <- if sslOn $ configTLS config
         then (do
-            infoM "Hsbot.Core" "TLS init"
+            infoM "Hsbot.Core" "Initializing TLS communication"
             tlsenv <- initTLSEnv (configTLS config)
             randomGen <- newGenIO :: IO SystemRandom
             sCtx <- client tlsenv randomGen connhdl
-            handshake sCtx
+            success <- handshake sCtx
+            unless success $ errorM "Hsbot.Core" "TLS handshake failed"  -- TODO: do some usefull error handling
             return (Just tlsenv, Just sCtx))
         else return (Nothing, Nothing)
     return BotEnv { envBotState    = botState
@@ -103,7 +103,7 @@ runHsbot = do
 
 botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
 botReader _ (Just ctx) chan _ = forever $
-    fmap L.toChunks (recvData ctx) >>= mapM_ (handleIncomingStr chan . C.unpack)  -- TODO exceptions
+    fmap L.toString (recvData ctx) >>= handleIncomingStr chan  -- TODO exceptions
 botReader handle Nothing chan fatherThreadId = forever $
     hGetLine handle `catch` handleIOException >>= handleIncomingStr chan
   where
@@ -118,9 +118,9 @@ handleIncomingStr :: Chan Message -> String -> IO ()
 handleIncomingStr chan str =
     case IRC.decode str of
         Just msg -> do
-            debugM "Ircd.Reader" $ "<-- " ++ show msg
+            debugM "Hsbot.Reader" $ "<-- " ++ show msg
             writeChan chan $ IncomingMsg msg
-        Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str     -- TODO: spam control
+        Nothing -> return ()
 
 botLoop :: Env IO ()
 botLoop = forever $ do
@@ -134,7 +134,7 @@ botLoop = forever $ do
             env <- ask
             let connhdl  = envHandle env
                 tlsCtx   = envTLSCtx env
-            liftIO $ debugM "Ircd.Reader" $ "--> " ++ show outMsg
+            liftIO $ debugM "Hsbot.Loop" $ "--> " ++ show outMsg
             liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
 
 terminateHsbot :: Env IO ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index c7331d3..7e340e3 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -79,8 +79,6 @@ data Config = Config
 
 data TLSConfig = TLSConfig
     { sslOn       :: Bool
-    , sslCert     :: String
-    , sslKey      :: String
     , sslVersions :: [Network.TLS.Version]
     , sslCiphers  :: [Network.TLS.Cipher]
     , sslVerify   :: Bool
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 6eec5c4..e56e9f7 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -2,23 +2,14 @@ module Hsbot.Utils
     ( addThreadIdToQuitMVar
     , delThreadIdFromQuitMVar
     , initTLSEnv
-    , readCertificate
-    , readPrivateKey
     , sendStr
     , setGlobalQuitMVar
     ) where
 
 import Control.Concurrent
 import Control.Monad.Reader
-import qualified Crypto.Cipher.RSA as RSA
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as L
-import qualified Data.Certificate.KeyRSA as KeyRSA
-import Data.Certificate.PEM
-import Data.Certificate.X509
+import qualified Data.ByteString.Lazy.UTF8 as L
 import Data.List
-import Data.Maybe
 import Network.TLS
 import System.IO
 
@@ -42,52 +33,14 @@ setGlobalQuitMVar status = do
 
 -- Helpers
 sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
-sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
-sendStr handle Nothing msg = hPutStrLn handle msg
+sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
+sendStr handle Nothing msg = hPutStrLn handle $ msg ++ "\r\n"
 
 -- TLS utils
 initTLSEnv :: TLSConfig -> IO TLSParams
 initTLSEnv ssl = do
-    let certFile = sslCert ssl
-        keyFile  = sslKey ssl
-        versions = sslVersions ssl
+    let versions = sslVersions ssl
         ciphers  = sslCiphers ssl
-        verify   = sslVerify ssl
-    -- TODO : exception on loading keys
-    cert <- readCertificate certFile
-    pk   <- readPrivateKey keyFile
-    return $ defaultParams { pConnectVersion = TLS12
-                           , pAllowedVersions = versions
-                           , pCiphers = ciphers
-                           , pWantClientCert = verify
-                           , pCertificates = [(cert, Just pk)] }
-
-readCertificate :: FilePath -> IO X509
-readCertificate filepath = do
-    content <- B.readFile filepath
-    let certdata = fromMaybe (error "no valid certificate section") $ parsePEMCert content
-        cert = case decodeCertificate $ L.fromChunks [certdata] of
-            Left err -> error ("cannot decode certificate: " ++ err)
-            Right x  -> x
-    return cert
-
-readPrivateKey :: FilePath -> IO PrivateKey
-readPrivateKey filepath = do
-    content <- B.readFile filepath
-    let pkdata = case parsePEMKeyRSA content of
-            Nothing -> error "no valid RSA key section"
-            Just x  -> L.fromChunks [x]
-    let pk = case KeyRSA.decodePrivate pkdata of
-            Left err -> error ("cannot decode key: " ++ err)
-            Right x  -> PrivRSA RSA.PrivateKey
-                { RSA.private_sz   = fromIntegral $ KeyRSA.lenmodulus x
-                , RSA.private_n    = KeyRSA.modulus x
-                , RSA.private_d    = KeyRSA.private_exponant x
-                , RSA.private_p    = KeyRSA.p1 x
-                , RSA.private_q    = KeyRSA.p2 x
-                , RSA.private_dP   = KeyRSA.exp1 x
-                , RSA.private_dQ   = KeyRSA.exp2 x
-                , RSA.private_qinv = KeyRSA.coef x
-                }
-    return pk
+    return $ defaultParams { pAllowedVersions = versions
+                           , pCiphers = ciphers }
 
diff --git a/hsbot.cabal b/hsbot.cabal
index ef9be31..96b9647 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -42,8 +42,9 @@ Library
                     network,
                     random,
                     safecopy,
-                    tls >= 0.6.1,
+                    tls >= 0.7.1,
                     tls-extra >= 0.2.0,
+                    utf8-string,
                     xdg-basedir
 
 
-- 
cgit v1.2.3


From e74094d5d9478c1f167c0ce4abc3c7e854af91c4 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Tue, 2 Aug 2011 23:08:52 +0200
Subject: Updated TODO list

---
 TODO | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/TODO b/TODO
index 07ac952..89fd863 100644
--- a/TODO
+++ b/TODO
@@ -1,5 +1,7 @@
-* owner rights
+* add admin rights
+* add the hability to manage rights for plugins, as quote editing
 * better hooks?
+* add help MVar
 
 
 
@@ -16,9 +18,7 @@
 * write the vote system for the quote module
 * only the quote reporter should be able to edit it
 * detect too identical quoting in a raw, or implement quote abort
-* handle the case we attempt to quote on an empty database
-* solve the multiquote problem about the quote owner (with a quoteElem data structure)
-* find a better way to track who voted for what?
+* find a better way to track who voted for what? - need authentication against the bot
 
 * write the help module
 * clean the plugin module
@@ -26,17 +26,11 @@
 * write a channel tracking plugin. Write the part chan command
 
 * add a plugin for admin checks and tracking
-* add the quoteadm command to the quote module
 * add a plugin for timer functionnalities other plugin could subscribe to (the troll plugin).
-* add register for casual conversations for plugins?
 * add a "I have stuff to save so don't kill me too hard" status for plugins
 
 * Make the bot auto-reconnect (/!\ admin plugin!)
-* discard all trace with a color param and replace those with functions info/warn/error/debug
-* write a safe reload : try reload before unloading
-* remove from Types.hs what can be removed from it
 
-* Find a way to handle bot reloading threw exec
 * Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
 * Find a way so that not a single message/information would be lost in the case of a reboot
 
-- 
cgit v1.2.3


From 1c8cab09cb00abc3e3a0ee2e4a2d7bd6cf703d2f Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Aug 2011 11:39:41 +0200
Subject: Added access controls to hsbot.

---
 Hsbot/Config.hs |  1 +
 Hsbot/Core.hs   |  1 +
 Hsbot/Types.hs  | 13 ++++++++++++-
 Hsbot/Utils.hs  | 19 +++++++++++++++++--
 TODO            |  4 +---
 5 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/Hsbot/Config.hs b/Hsbot/Config.hs
index 8c85810..6053e9e 100644
--- a/Hsbot/Config.hs
+++ b/Hsbot/Config.hs
@@ -16,6 +16,7 @@ defaultConfig = Config
     , configTLS       = noSSL
     , configAddress   = "localhost"
     , configPort      = PortNumber 6667
+    , configAccess    = []
     , configChannels  = ["#hsbot"]
     , configNicknames = ["hsbot"]
     , configRealname  = "The One True bot, with it's haskell soul."
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 11c8732..eacbe63 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -76,6 +76,7 @@ runHsbot = do
         mapM_ (liftIO . sendStr 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
                                                             , botHooks    = []
                                                             , botChannels = channels
                                                             , botNickname = nickname }
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 7e340e3..8f84482 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -1,5 +1,7 @@
 module Hsbot.Types
-    ( Bot
+    ( AccessList (..)
+    , AccessRight (..)
+    , Bot
     , BotState (..)
     , BotStatus (..)
     , BotEnv (..)
@@ -40,6 +42,7 @@ type Bot = StateT BotState
 
 data BotState = BotState
     { botPlugins  :: M.Map String (PluginEnv, ThreadId)
+    , botAccess   :: [AccessList]
     , botHooks    :: [Chan Message]
     , botChannels :: [String]
     , botNickname :: String
@@ -71,12 +74,20 @@ data Config = Config
     , configTLS       :: TLSConfig
     , configAddress   :: String
     , configPort      :: PortID
+    , configAccess    :: [AccessList]
     , configChannels  :: [String]
     , configNicknames :: [String]
     , configRealname  :: String
     , configPlugins   :: [PluginId]
     }
 
+data AccessRight = Admin | JoinPart | Kick | Say deriving (Eq, Show)
+
+data AccessList = AccessList
+    { accessMask :: IRC.Prefix
+    , accessList :: [AccessRight]
+    } deriving (Show)
+
 data TLSConfig = TLSConfig
     { sslOn       :: Bool
     , sslVersions :: [Network.TLS.Version]
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index e56e9f7..912e746 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -1,6 +1,7 @@
 module Hsbot.Utils
     ( addThreadIdToQuitMVar
     , delThreadIdFromQuitMVar
+    , hasAccess
     , initTLSEnv
     , sendStr
     , setGlobalQuitMVar
@@ -8,8 +9,10 @@ module Hsbot.Utils
 
 import Control.Concurrent
 import Control.Monad.Reader
+import Control.Monad.State
 import qualified Data.ByteString.Lazy.UTF8 as L
-import Data.List
+import qualified Data.List as L
+import qualified Network.IRC as IRC
 import Network.TLS
 import System.IO
 
@@ -24,13 +27,25 @@ addThreadIdToQuitMVar thrId = do
 delThreadIdFromQuitMVar :: ThreadId -> Env IO ()
 delThreadIdFromQuitMVar thrId = do
     threadIdsMv <- asks envThreadIdsMv
-    liftIO $ modifyMVar_ threadIdsMv (return . delete thrId)
+    liftIO $ modifyMVar_ threadIdsMv (return . L.delete thrId)
 
 setGlobalQuitMVar :: BotStatus -> Env IO ()
 setGlobalQuitMVar status = do
     quitMv <- asks envQuitMv
     liftIO $ putMVar quitMv status
 
+-- Access rights
+hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO (Bool)
+hasAccess Nothing _ = return False
+hasAccess (Just mask) right = do
+    botMVar <- asks envBotState
+    liftIO (readMVar botMVar) >>= evalStateT (gets botAccess >>= return . or . map accessMatch)
+  where
+    accessMatch :: AccessList -> Bool
+    accessMatch (AccessList amask arights)
+      | mask == amask = or [L.elem Admin arights, L.elem right arights]
+      | otherwise = False
+
 -- Helpers
 sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
 sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
diff --git a/TODO b/TODO
index 89fd863..cb32d7c 100644
--- a/TODO
+++ b/TODO
@@ -1,8 +1,6 @@
-* add admin rights
-* add the hability to manage rights for plugins, as quote editing
 * better hooks?
 * add help MVar
-
+* add regexes support in accessList prefix
 
 
 
-- 
cgit v1.2.3


From 4f50db840967c2409c9bf96c2d6525f99e39cdca Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Aug 2011 13:03:31 +0200
Subject: Fixed bad comments and some cosmetics

---
 Hsbot/Plugin/Duck.hs | 2 +-
 Hsbot/Plugin/Ping.hs | 3 ++-
 Hsbot/Utils.hs       | 6 +++---
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 946cb0c..b152685 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -51,7 +51,7 @@ $(makeAcidic ''StatDB ['getDuckStats, 'updateScore])
 duck :: PluginId
 duck = PluginId
     { pluginName = "duck"
-    , pluginEp   = theDuck $ DuckArgs { duckChannel = "", duckFreq = 10 } }
+    , pluginEp   = theDuck DuckArgs { duckChannel = "", duckFreq = 10 } }
 
 data DuckArgs = DuckArgs
     { duckChannel :: String
diff --git a/Hsbot/Plugin/Ping.hs b/Hsbot/Plugin/Ping.hs
index 6d28ef9..9105630 100644
--- a/Hsbot/Plugin/Ping.hs
+++ b/Hsbot/Plugin/Ping.hs
@@ -11,12 +11,13 @@ import Prelude hiding (catch)
 import Hsbot.Message
 import Hsbot.Types
 
+-- | The ping plugin identity
 ping :: PluginId
 ping = PluginId
     { pluginName = "ping"
     , pluginEp   = thePing }
 
--- | The IrcPlugin monad main function
+-- | An IRC plugin that answer PING requests
 thePing :: Plugin (Env IO) ()
 thePing = forever $ readMsg >>= eval
   where
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 912e746..2a8f58c 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -35,15 +35,15 @@ setGlobalQuitMVar status = do
     liftIO $ putMVar quitMv status
 
 -- Access rights
-hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO (Bool)
+hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO Bool
 hasAccess Nothing _ = return False
 hasAccess (Just mask) right = do
     botMVar <- asks envBotState
-    liftIO (readMVar botMVar) >>= evalStateT (gets botAccess >>= return . or . map accessMatch)
+    liftIO (readMVar botMVar) >>= evalStateT (fmap (any accessMatch) (gets botAccess))
   where
     accessMatch :: AccessList -> Bool
     accessMatch (AccessList amask arights)
-      | mask == amask = or [L.elem Admin arights, L.elem right arights]
+      | mask == amask = or [Admin `L.elem` arights, right `L.elem` arights]
       | otherwise = False
 
 -- Helpers
-- 
cgit v1.2.3


From fe1acc3db5bafdf0b3b336d70a4c19e343b09852 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Aug 2011 13:05:25 +0200
Subject: Added Administrative plugin that will permit dynamic reloading

---
 Hsbot/Plugin/Admin.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++
 hsbot.cabal           |  1 +
 2 files changed, 46 insertions(+)
 create mode 100644 Hsbot/Plugin/Admin.hs

diff --git a/Hsbot/Plugin/Admin.hs b/Hsbot/Plugin/Admin.hs
new file mode 100644
index 0000000..7dba362
--- /dev/null
+++ b/Hsbot/Plugin/Admin.hs
@@ -0,0 +1,45 @@
+module Hsbot.Plugin.Admin
+    ( admin
+    , theAdmin
+    ) where
+
+import Control.Concurrent.Chan ()
+import Control.Monad.Reader
+import qualified Network.IRC as IRC
+import Prelude hiding (catch)
+
+import Hsbot.Message
+import Hsbot.Types
+import Hsbot.Utils
+
+-- | The Admin plugin identity
+admin :: PluginId
+admin = PluginId
+    { pluginName = "admin"
+    , pluginEp   = theAdmin }
+
+-- | An IRC plugin for manage hsbot
+theAdmin :: Plugin (Env IO) ()
+theAdmin = forever $ readMsg >>= eval
+  where
+    eval :: Message -> Plugin (Env IO) ()
+    eval (IncomingMsg msg)
+        | IRC.msg_command msg == "PRIVMSG" = do
+            cmdArgs <- lift $ getCommand msg
+            case cmdArgs of
+                "exit":"help":_ -> answerMsg msg "exit hsbot."
+                "exit":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
+                        then lift $ setGlobalQuitMVar BotExit
+                        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
+                        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
+                        else answerMsg msg "Only admins can do that."
+                _ -> return ()
+        | otherwise = return ()
+    eval _ = return ()
+
diff --git a/hsbot.cabal b/hsbot.cabal
index 96b9647..0e5473d 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -23,6 +23,7 @@ Library
                     Hsbot.Core
                     Hsbot.Message
                     Hsbot.Plugin
+                    Hsbot.Plugin.Admin
                     Hsbot.Plugin.Duck
                     Hsbot.Plugin.Ping
                     Hsbot.Types
-- 
cgit v1.2.3


From 3b914c1b7729f52ba96e51ad43424909acae681c Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Aug 2011 20:56:20 +0200
Subject: Added exception handling, an autorestart when that happens and output
 in case of restart/reload

---
 Hsbot.hs              | 30 +++++++++++++++++++++++++++---
 Hsbot/Core.hs         | 35 +++++++++++++++++------------------
 Hsbot/Plugin/Admin.hs |  4 ++--
 Hsbot/Types.hs        |  2 +-
 Hsbot/Utils.hs        | 15 ++++++++++++---
 TODO                  | 11 ++---------
 6 files changed, 61 insertions(+), 36 deletions(-)

diff --git a/Hsbot.hs b/Hsbot.hs
index c02b2e5..08456bf 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -5,13 +5,19 @@ module Hsbot
 import qualified Config.Dyre as Dyre
 import Config.Dyre.Relaunch
 import Control.Monad.Reader
+import qualified Data.Map as M
 import System.Log.Logger
+import qualified Network.IRC as IRC
 
 import Hsbot.Core
 import Hsbot.Types
+import Hsbot.Utils
+
+data State = State (M.Map String String) deriving (Read, Show)
 
 startHsbot :: Config -> IO ()
 startHsbot config = do
+    (State buffer) <- restoreTextState $ State M.empty
     -- checking for configuration file compilation error
     case configErrors config of
          Nothing -> return ()
@@ -19,16 +25,34 @@ startHsbot config = do
     -- initialization
     infoM "Hsbot" "Bot initializations"
     hsbotEnv <- initHsbot config
+    -- Handle previous exit state if it exists
+    die_msgs <- case M.lookup "die_msg" buffer of
+        Just dieMsg -> case reads dieMsg :: [(BotStatus, String)] of
+            (status, _):_ -> case status of
+                BotReload reason -> return ["hsbot reloaded, reason : " ++ reason]
+                BotRestart (reason, Just info) -> return ["hsbot restarted, readon : " ++ reason, "additional information: " ++ info]
+                BotRestart (reason, Nothing) -> return ["hsbot restarted, readon : " ++ reason]
+                BotExit -> return []
+            _ -> return ["hsbot die_msg parsing error, this should not happen"]
+        Nothing -> return []
+    let connhdl  = envHandle hsbotEnv
+        tlsCtx   = envTLSCtx hsbotEnv
+        channels = configChannels config
+    mapM_ (infoM "Hsbot") die_msgs
+    mapM_ (\msg -> mapM_ (\channel -> sendStr hsbotEnv connhdl tlsCtx . IRC.encode $ IRC.Message Nothing "PRIVMSG" [channel, msg]) channels) die_msgs
     -- main stuff
     infoM "Hsbot" "Bot core starting"
     status <- runReaderT runHsbot hsbotEnv
     infoM "Hsbot" $ "Bot core exited with status " ++ show status
     -- Handling exit signal
     case status of
-         BotContinue -> startHsbot config -- TODO do something not so dumb about starting over
          BotExit -> runReaderT terminateHsbot hsbotEnv
-         BotReload -> relaunchMaster Nothing -- TODO relaunchWithTextState (state { stateConfig = config }) Nothing, add a flag that prevent spawning the sockets again
-         BotRestart -> relaunchMaster Nothing -- TODO relaunch and kill sockets
+         BotReload reason -> do
+             runReaderT terminateHsbot hsbotEnv
+             relaunchWithTextState (M.singleton "die_msg" . show $ BotReload reason) Nothing  -- TODO find a way to properly implement that, then insert necessary information in this MVar
+         BotRestart reason -> do
+             runReaderT terminateHsbot hsbotEnv
+             relaunchWithTextState (M.singleton "die_msg" . show $ BotRestart reason) Nothing
 
 hsbot :: Config -> IO ()
 hsbot = Dyre.wrapMain $ Dyre.defaultParams
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
diff --git a/TODO b/TODO
index cb32d7c..92d1f3e 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,7 @@
 * better hooks?
 * add help MVar
 * add regexes support in accessList prefix
-
+* exception handling on channel and MVar operations?
 
 
 
@@ -9,7 +9,6 @@
 
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
-* Improve configuration file errors display
 * fork process in background
 
 * add a function to answer by /msg to somebody
@@ -18,16 +17,10 @@
 * detect too identical quoting in a raw, or implement quote abort
 * find a better way to track who voted for what? - need authentication against the bot
 
-* write the help module
-* clean the plugin module
-* clean cleaning for the quote module
 * write a channel tracking plugin. Write the part chan command
 
-* add a plugin for admin checks and tracking
+* add a plugin for admin rights checking and user tracking
 * add a plugin for timer functionnalities other plugin could subscribe to (the troll plugin).
-* add a "I have stuff to save so don't kill me too hard" status for plugins
-
-* Make the bot auto-reconnect (/!\ admin plugin!)
 
 * Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
 * Find a way so that not a single message/information would be lost in the case of a reboot
-- 
cgit v1.2.3


From d933088dcb7d9b7ed05e0fbeb478472e0dae5a7a Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Aug 2011 21:11:01 +0200
Subject: cosmetic

---
 Hsbot/Utils.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 043037d..2ea1a49 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -40,8 +40,7 @@ setGlobalQuitMVar status = do
 hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO Bool
 hasAccess Nothing _ = return False
 hasAccess (Just mask) right = do
-    botMVar <- asks envBotState
-    liftIO (readMVar botMVar) >>= evalStateT (fmap (any accessMatch) (gets botAccess))
+    asks envBotState >>= liftIO . readMVar >>= evalStateT (fmap (any accessMatch) (gets botAccess))
   where
     accessMatch :: AccessList -> Bool
     accessMatch (AccessList amask arights)
-- 
cgit v1.2.3


From 98a1debf03cd0b5145578f823b025d2315394503 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Tue, 9 Aug 2011 23:48:15 +0200
Subject: Moved to death messages IRC output around, because those were sent
 too soon

---
 Hsbot.hs      | 22 ++++++++--------------
 Hsbot/Core.hs |  6 ++++--
 2 files changed, 12 insertions(+), 16 deletions(-)

diff --git a/Hsbot.hs b/Hsbot.hs
index 08456bf..33cfa45 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -7,11 +7,9 @@ import Config.Dyre.Relaunch
 import Control.Monad.Reader
 import qualified Data.Map as M
 import System.Log.Logger
-import qualified Network.IRC as IRC
 
 import Hsbot.Core
 import Hsbot.Types
-import Hsbot.Utils
 
 data State = State (M.Map String String) deriving (Read, Show)
 
@@ -22,27 +20,23 @@ startHsbot config = do
     case configErrors config of
          Nothing -> return ()
          Just em -> putStrLn $ "Error: " ++ em
-    -- initialization
-    infoM "Hsbot" "Bot initializations"
-    hsbotEnv <- initHsbot config
     -- Handle previous exit state if it exists
-    die_msgs <- case M.lookup "die_msg" buffer of
+    dieMsgs <- case M.lookup "die_msg" buffer of
         Just dieMsg -> case reads dieMsg :: [(BotStatus, String)] of
             (status, _):_ -> case status of
                 BotReload reason -> return ["hsbot reloaded, reason : " ++ reason]
-                BotRestart (reason, Just info) -> return ["hsbot restarted, readon : " ++ reason, "additional information: " ++ info]
-                BotRestart (reason, Nothing) -> return ["hsbot restarted, readon : " ++ reason]
+                BotRestart (reason, Just info) -> return ["hsbot restarted, reason : " ++ reason, "additional information: " ++ info]
+                BotRestart (reason, Nothing) -> return ["hsbot restarted, reason : " ++ reason]
                 BotExit -> return []
             _ -> return ["hsbot die_msg parsing error, this should not happen"]
         Nothing -> return []
-    let connhdl  = envHandle hsbotEnv
-        tlsCtx   = envTLSCtx hsbotEnv
-        channels = configChannels config
-    mapM_ (infoM "Hsbot") die_msgs
-    mapM_ (\msg -> mapM_ (\channel -> sendStr hsbotEnv connhdl tlsCtx . IRC.encode $ IRC.Message Nothing "PRIVMSG" [channel, msg]) channels) die_msgs
+    mapM_ (infoM "Hsbot") dieMsgs
+    -- initialization
+    infoM "Hsbot" "Bot initializations"
+    hsbotEnv <- initHsbot config
     -- main stuff
     infoM "Hsbot" "Bot core starting"
-    status <- runReaderT runHsbot hsbotEnv
+    status <- runReaderT (runHsbot dieMsgs) hsbotEnv
     infoM "Hsbot" $ "Bot core exited with status " ++ show status
     -- Handling exit signal
     case status of
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 49f5f5d..4dc1e92 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -53,8 +53,8 @@ initHsbot config = do
                   , envTLS         = tls
                   , envTLSCtx      = tlsCtx }
 
-runHsbot :: Env IO BotStatus
-runHsbot = do
+runHsbot :: [String] -> Env IO BotStatus
+runHsbot die_msgs = do
     botNotInitialized <- asks envBotState >>= liftIO . isEmptyMVar
     when botNotInitialized runFirstSteps
     trueRunHsbot
@@ -74,6 +74,8 @@ runHsbot = do
         liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
         -- Then we join channels
         mapM_ (liftIO . sendStr env connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
+        -- We advertise any death message we should
+        mapM_ (\msg -> mapM_ (\channel -> liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.Message Nothing "PRIVMSG" [channel, msg]) channels) die_msgs
         -- Finally we set the new bot state
         asks envBotState >>= liftIO . flip putMVar BotState { botPlugins  = M.empty
                                                             , botAccess   = configAccess config
-- 
cgit v1.2.3


From f698fd218375a0bfebd466a1cdc043427c2379b6 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Tue, 9 Aug 2011 23:55:03 +0200
Subject: Fixed mistake that prevented death message to be parsed upon
 restarting

---
 Hsbot.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Hsbot.hs b/Hsbot.hs
index 33cfa45..e2e771e 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -43,10 +43,10 @@ startHsbot config = do
          BotExit -> runReaderT terminateHsbot hsbotEnv
          BotReload reason -> do
              runReaderT terminateHsbot hsbotEnv
-             relaunchWithTextState (M.singleton "die_msg" . show $ BotReload reason) Nothing  -- TODO find a way to properly implement that, then insert necessary information in this MVar
+             relaunchWithTextState (State $ M.singleton "die_msg" . show $ BotReload reason) Nothing  -- TODO find a way to properly implement that, then insert necessary information in this MVar
          BotRestart reason -> do
              runReaderT terminateHsbot hsbotEnv
-             relaunchWithTextState (M.singleton "die_msg" . show $ BotRestart reason) Nothing
+             relaunchWithTextState (State $ M.singleton "die_msg" . show $ BotRestart reason) Nothing
 
 hsbot :: Config -> IO ()
 hsbot = Dyre.wrapMain $ Dyre.defaultParams
-- 
cgit v1.2.3


From f1ce0cfee09c5ba316abe437befa8ad75b3a5aa6 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 2 Sep 2011 16:38:27 +0200
Subject: Added score sorting for the duck module

---
 Hsbot/Plugin/Duck.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index b152685..1044591 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -13,6 +13,7 @@ import Data.Acid
 import qualified Data.List as L
 import qualified Data.Map as M
 import Data.Maybe
+import Data.Ord ()
 import Data.SafeCopy
 import Data.Typeable
 import qualified Network.IRC as IRC
@@ -151,8 +152,13 @@ bangs = [ "PAN", "PAN!" ]
 printDuckStats :: String -> StatDB -> Plugin (Env IO) ()
 printDuckStats channel statDB = do
     sendLine "Duck slaughter simulator - Hall of Fame"
-    mapM_ (sendLine . buildLine) $ M.toList (nickStats statDB)
+    mapM_ (sendLine . buildLine) . reverse . L.sortBy scoreSort $ M.toList (nickStats statDB)
   where
+    scoreSort :: (String, Int) -> (String, Int) -> Ordering
+    scoreSort (_, s1) (_,s2)
+      | s1 < s2 = LT
+      | s1 > s2 = GT
+      | otherwise = EQ
     buildLine :: (String, Int) -> String
     buildLine (nick, score) = concat [ nick,  ": ", show score ]
     sendLine :: String -> Plugin (Env IO) ()
-- 
cgit v1.2.3