Consolidated Nick types

hask-irc-core/Network/IRC/Protocol.hs

@@ -49,11 +49,11 @@ lineParser BotConfig { .. } time line msgParts = flip Done msgParts . Message ti
     "JOIN"    -> JoinMsg user
     "QUIT"    -> QuitMsg user quitMessage
     "PART"    -> PartMsg user message
-    "KICK"    -> KickMsg user kicked kickReason
-    "MODE"    -> if source == botNick
+    "KICK"    -> KickMsg user (Nick kicked) kickReason
+    "MODE"    -> if Nick source == botNick
                    then ModeMsg Self target message []
                    else ModeMsg user target mode modeArgs
-    "NICK"    -> NickMsg user (drop 1 target)
+    "NICK"    -> NickMsg user $ Nick (drop 1 target)
     "433"     -> NickInUseMsg
     "PRIVMSG" | target /= channel -> PrivMsg user message
               | isActionMsg       -> ActionMsg user (initDef . drop 8 $ message)
@@ -66,7 +66,7 @@ lineParser BotConfig { .. } time line msgParts = flip Done msgParts . Message ti
     target          = splits !! 2
     message         = strip . drop 1 . unwords . drop 3 $ splits
     quitMessage     = strip . drop 1 . unwords . drop 2 $ splits
-    user            = uncurry User . second (drop 1) . break (== '!') $ source
+    user            = uncurry User . (Nick *** drop 1) . break (== '!') $ source
     mode            = splits !! 3
     modeArgs        = drop 4 splits
     kicked          = splits !! 3
@@ -89,17 +89,18 @@ namesParser BotConfig { .. } time line msgParts = case command of
   where
     (_ : command : target : _) = words line
     stripNickPrefix  = pack . dropWhile (`elem` ("~&@%+" :: String)) . unpack
-    namesNicks line' = map stripNickPrefix . words . drop 1 . unwords . drop 5 . words $ line'
+    namesNicks line' =
+      map (Nick . stripNickPrefix) . words . drop 1 . unwords . drop 5 . words $ line'
 
 lineFromCommand :: BotConfig -> Command -> Maybe Text
 lineFromCommand BotConfig { .. } command = case command of
   PongCmd { .. }                  -> Just $ "PONG :" ++ rmsg
   PingCmd { .. }                  -> Just $ "PING :" ++ rmsg
-  NickCmd                         -> Just $ "NICK " ++ botNick
-  UserCmd                         -> Just $ "USER " ++ botNick ++ " 0 * :" ++ botNick
+  NickCmd                         -> Just $ "NICK " ++ nickToText botNick
+  UserCmd                         -> Just $ "USER " ++ nickToText botNick ++ " 0 * :" ++ nickToText botNick
   JoinCmd                         -> Just $ "JOIN " ++ channel
   QuitCmd                         -> Just "QUIT"
   ChannelMsgReply { .. }          -> Just $ "PRIVMSG " ++ channel ++ " :" ++ rmsg
-  PrivMsgReply (User { .. }) rmsg -> Just $ "PRIVMSG " ++ userNick ++ " :" ++ rmsg
+  PrivMsgReply (User { .. }) rmsg -> Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ rmsg
   NamesCmd                        -> Just $ "NAMES " ++ channel
   _                               -> Nothing

hask-irc-core/Network/IRC/Types.hs

@@ -1,10 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Network.IRC.Types
-  ( Nick
+  ( Nick (..)
   , MsgHandlerName
   , User (..)
   , Message (..)
@@ -33,14 +35,21 @@ import Control.Monad.Base      (MonadBase)
 import Control.Monad.Reader    (ReaderT, MonadReader, runReaderT)
 import Control.Monad.State     (StateT, MonadState, execStateT)
 import Data.Configurator.Types (Config)
+import Data.Data               (Data)
+import Data.SafeCopy           (base, deriveSafeCopy)
 import Data.Typeable           (cast)
 
 import Network.IRC.Util
 
 -- IRC related
 
-type Nick           = Text
-type MsgHandlerName = Text
+newtype Nick = Nick { nickToText :: Text }
+               deriving (Eq, Ord, Data, Typeable, Hashable)
+
+instance Show Nick where
+  show = unpack . nickToText
+
+$(deriveSafeCopy 0 'base ''Nick)
 
 data User = Self | User { userNick :: !Nick, userServer :: !Text }
             deriving (Show, Eq)
@@ -104,10 +113,12 @@ data EventResponse =  RespNothing
 
 -- Bot
 
+type MsgHandlerName = Text
+
 data BotConfig = BotConfig { server         :: !Text
                            , port           :: !Int
                            , channel        :: !Text
-                           , botNick        :: !Text
+                           , botNick        :: !Nick
                            , botTimeout     :: !Int
                            , msgHandlerInfo :: !(Map MsgHandlerName (Map Text Text))
                            , config         :: !Config }

hask-irc-core/hask-irc-core.cabal

@@ -57,6 +57,7 @@ library
                        text                 >=0.11    && <0.12,
                        mtl                  >=2.1     && <2.2,
                        configurator         >=0.2     && <0.3,
+                       safecopy             >=0.8     && <0.9,
                        time                 >=1.4     && <1.5,
                        classy-prelude       >=0.9     && <1.0,
                        text-format          >=0.3     && <0.4,

hask-irc-handlers/Network/IRC/Handlers/Auth.hs

@@ -74,5 +74,5 @@ mkMsgHandler BotConfig { .. } _ "auth" = do
                                 , onStop    = stopAuth state
                                 , onHelp    = return $ singletonMap "token" helpMsg }
   where
-    helpMsg = "Send a PM to get a new auth token. /msg " ++ botNick ++ " token"
+    helpMsg = "Send a PM to get a new auth token. /msg " ++ nickToText botNick ++ " token"
 mkMsgHandler _ _ _                     = return Nothing

hask-irc-handlers/Network/IRC/Handlers/Auth/Types.hs

@@ -23,4 +23,5 @@ data AuthEvent = AuthEvent Nick Token (MVar Bool) deriving (Typeable)
 instance Event AuthEvent
 
 instance Show AuthEvent where
-  show (AuthEvent user token _) = "AuthEvent[" ++ unpack user ++ ", " ++ unpack token ++ "]"
+  show (AuthEvent nick token _) =
+    "AuthEvent[" ++ unpack (nickToText nick) ++ ", " ++ unpack token ++ "]"

hask-irc-handlers/Network/IRC/Handlers/Greet.hs

@@ -14,7 +14,8 @@ mkMsgHandler _ _ _          = return Nothing
 
 greeter ::  MonadMsgHandler m => Message -> m (Maybe Command)
 greeter Message { msgDetails = ChannelMsg { .. }, .. } =
-  return . map (ChannelMsgReply . (++ userNick user) . (++ " ")) . find (== clean msg) $ greetings
+  return . map (ChannelMsgReply . (++ nickToText (userNick user)) . (++ " "))
+    . find (== clean msg) $ greetings
   where
     greetings = [ "hi", "hello", "hey", "sup", "bye"
                 , "good morning", "good evening", "good night" ]
@@ -24,7 +25,7 @@ welcomer :: MonadMsgHandler m => Message -> m (Maybe Command)
 welcomer Message { msgDetails = JoinMsg { .. }, .. } = do
   BotConfig { .. } <- ask
   if userNick user /= botNick
-    then return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
+    then return . Just . ChannelMsgReply $ "welcome back " ++ nickToText (userNick user)
     else return Nothing
 
 welcomer _ = return Nothing

hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs

@@ -32,7 +32,7 @@ getLogFilePath :: BotConfig -> IO FilePath
 getLogFilePath BotConfig { .. } = do
   logFileDir <- C.require config "messagelogger.logdir"
   createDirectoryIfMissing True logFileDir
-  return $ logFileDir </> unpack (channel ++ "-" ++ botNick) <.> "log"
+  return $ logFileDir </> unpack (channel ++ "-" ++ nickToText botNick) <.> "log"
 
 openLogFile :: FilePath -> IO Handle
 openLogFile logFilePath = do
@@ -74,16 +74,18 @@ withLogFile action state = do
 
 messageLogger :: MonadMsgHandler m => Message -> IORef LoggerState -> m (Maybe Command)
 messageLogger Message { .. } = case msgDetails of
-  ChannelMsg { .. } -> log "<{}> {}"                  [userNick user, msg]
-  ActionMsg { .. }  -> log "<{}> {} {}"               [userNick user, userNick user, msg]
-  KickMsg { .. }    -> log "** {} KICKED {} :{}"      [userNick user, kickedNick, msg]
-  JoinMsg { .. }    -> log "** {} JOINED"             [userNick user]
-  PartMsg { .. }    -> log "** {} PARTED :{}"         [userNick user, msg]
-  QuitMsg { .. }    -> log "** {} QUIT :{}"           [userNick user, msg]
-  NickMsg { .. }    -> log "** {} CHANGED NICK TO {}" [userNick user, newNick]
-  NamesMsg { .. }   -> log "** USERS {}"              [unwords nicks]
+  ChannelMsg { .. } -> log "<{}> {}"                  [nick user, msg]
+  ActionMsg { .. }  -> log "<{}> {} {}"               [nick user, nick user, msg]
+  KickMsg { .. }    -> log "** {} KICKED {} :{}"      [nick user, nickToText kickedNick, msg]
+  JoinMsg { .. }    -> log "** {} JOINED"             [nick user]
+  PartMsg { .. }    -> log "** {} PARTED :{}"         [nick user, msg]
+  QuitMsg { .. }    -> log "** {} QUIT :{}"           [nick user, msg]
+  NickMsg { .. }    -> log "** {} CHANGED NICK TO {}" [nick user, nickToText newNick]
+  NamesMsg { .. }   -> log "** USERS {}"              [unwords . map nickToText $ nicks]
   _                 -> const $ return Nothing
   where
+    nick = nickToText . userNick
+
     log format args = withLogFile $ \logFile ->
       TF.hprint logFile ("[{}] " ++ format ++ "\n") $ TF.buildParams (fmtTime msgTime : args)
 

hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs

@@ -20,9 +20,11 @@ import Data.IxSet                (getOne, (@=))
 import Data.Time                 (addUTCTime, NominalDiffTime)
 
 import Network.IRC.Handlers.NickTracker.Types
-import Network.IRC.Types hiding (Nick)
+import Network.IRC.Types
 import Network.IRC.Util
 
+-- database
+
 getByNickQ :: Nick -> Query NickTracking (Maybe NickTrack)
 getByNickQ nick = do
   NickTracking { .. } <- ask
@@ -40,12 +42,14 @@ saveNickTrackQ nt = do
 
 $(makeAcidic ''NickTracking ['getByNickQ, 'getByCanonicalNickQ, 'saveNickTrackQ])
 
-getByNick :: AcidState NickTracking -> Text -> IO (Maybe NickTrack)
-getByNick acid = query acid . GetByNickQ . Nick
+getByNick :: AcidState NickTracking -> Nick -> IO (Maybe NickTrack)
+getByNick acid = query acid . GetByNickQ
 
 saveNickTrack :: AcidState NickTracking -> NickTrack -> IO ()
 saveNickTrack acid = update acid . SaveNickTrackQ
 
+-- handler
+
 data NickTrackingState = NickTrackingState { acid            :: AcidState NickTracking
                                            , refreshInterval :: NominalDiffTime
                                            , onlineNicks     :: HashSet Nick
@@ -73,14 +77,14 @@ nickTrackerMsg state message@Message { .. } = case msgDetails of
     updateRefreshTime = atomicModIORef state $ \ s -> s { lastRefreshOn = msgTime }
 
     modifyOnlineNicks f = atomicModIORef state $ \s -> s { onlineNicks = f . onlineNicks $ s }
-    add        = modifyOnlineNicks . flip ((. (Nick . userNick)) . flip insertSet)
-    remove     = modifyOnlineNicks . flip ((. (Nick . userNick)) . flip deleteSet)
+    add        = modifyOnlineNicks . flip ((. userNick) . flip insertSet)
+    remove     = modifyOnlineNicks . flip ((. userNick) . flip deleteSet)
     swap users = modifyOnlineNicks $
-      let (oNick, nNick) = both (Nick . userNick) users
+      let (oNick, nNick) = both userNick users
       in deleteSet oNick . insertSet nNick
-    refresh    = modifyOnlineNicks . const . setFromList . map Nick
+    refresh    = modifyOnlineNicks . const . setFromList
 
-    commands = [ ("!nick",        handleNickCommand)
+    commands = [ ("!nicks",       handleNickCommand)
                , ("!seen",        handleSeenCommand)
                , ("!forgetnicks", handleForgetNicksCommand)]
 
@@ -98,9 +102,9 @@ updateNickTrack state user message msgTime = io $ do
     (_, Just (NickTrack { .. }))  -> return (message, msgTime, canonicalNick)
     _                             -> newCanonicalNick >>= \cn -> return (message, msgTime, cn)
 
-  saveNickTrack acid $ NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message'
+  saveNickTrack acid $ NickTrack nck cn (LastSeenOn msgTime) lastMessageOn' message'
 
-handleNickChange :: MonadMsgHandler m => IORef NickTrackingState -> User -> Text -> UTCTime -> m ()
+handleNickChange :: MonadMsgHandler m => IORef NickTrackingState -> User -> Nick -> UTCTime -> m ()
 handleNickChange state user newNick msgTime = io $ do
   NickTrackingState { .. } <- readIORef state
   let prevNick = userNick user
@@ -116,7 +120,7 @@ handleNickChange state user newNick msgTime = io $ do
     _ -> return Nothing
 
   whenJust mInfo $ \(message, cn, lastMessageOn') ->
-    saveNickTrack acid $ NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message
+    saveNickTrack acid $ NickTrack newNick cn (LastSeenOn msgTime) lastMessageOn' message
 
 newCanonicalNick :: IO CanonicalNick
 newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom
@@ -130,7 +134,7 @@ withNickTracks f state message = io $ do
   if nick == ""
     then return Nothing
     else do
-      mcn <- liftM (map canonicalNick) . getByNick acid $ nick
+      mcn <- liftM (map canonicalNick) . getByNick acid . Nick $ nick
       map (Just . ChannelMsgReply) $ case mcn of
         Nothing -> return $ "Unknown nick: " ++ nick
         Just cn -> io $ query acid (GetByCanonicalNickQ cn) >>= \nts -> f nick nts onlineNicks
@@ -168,7 +172,7 @@ handleForgetNicksCommand state Message { msgDetails = ~ChannelMsg { .. }, .. } =
     Just nt <- getByNick acid nick
     cn      <- newCanonicalNick
     saveNickTrack acid $ nt { canonicalNick = cn }
-  return . Just . ChannelMsgReply $ "Forgot all alternate nicks of " ++ nick
+  return . Just . ChannelMsgReply $ "Forgot all alternate nicks of " ++ nickToText nick
 
 stopNickTracker :: MonadMsgHandler m => IORef NickTrackingState -> m ()
 stopNickTracker state = io $ do
@@ -188,6 +192,7 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do
                                 , onHelp    = return helpMsgs }
   where
     helpMsgs = mapFromList [
-      ("!nick", "Shows the user's other nicks. !nick <user nick>"),
-      ("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>") ]
+      ("!nicks", "Shows alternate nicks of the user. !nicks <user nick>"),
+      ("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>"),
+      ("!forgetnicks", "Forgets all your alternate nicks. !forgetnicks") ]
 mkMsgHandler _ _ _                            = return Nothing

hask-irc-handlers/Network/IRC/Handlers/NickTracker/Types.hs

@@ -7,7 +7,8 @@ import Data.Data     (Data)
 import Data.IxSet    (IxSet, Indexable (..), ixSet, ixFun)
 import Data.SafeCopy (base, deriveSafeCopy)
 
-newtype Nick          = Nick Text          deriving (Eq, Ord, Show, Data, Typeable, Hashable)
+import Network.IRC.Types
+
 newtype CanonicalNick = CanonicalNick Text deriving (Eq, Ord, Show, Data, Typeable)
 newtype LastSeenOn    = LastSeenOn UTCTime deriving (Eq, Ord, Show, Data, Typeable)
 
@@ -27,7 +28,6 @@ instance Indexable NickTrack where
 newtype NickTracking = NickTracking { nickTracking :: IxSet NickTrack }
                        deriving (Eq, Ord, Show, Data, Typeable)
 
-$(deriveSafeCopy 0 'base ''Nick)
 $(deriveSafeCopy 0 'base ''CanonicalNick)
 $(deriveSafeCopy 0 'base ''LastSeenOn)
 $(deriveSafeCopy 0 'base ''NickTrack)

hask-irc-runner/Network/IRC/Runner.hs

@@ -57,13 +57,13 @@ loadBotConfig configFile = do
       eBotConfig <- try $ do
         handlers :: [Text] <- CF.require cfg "msghandlers"
         let handlerInfo = foldl' (\m h -> insertMap h mempty m) mempty handlers
-        BotConfig                  <$>
-          CF.require cfg "server"  <*>
-          CF.require cfg "port"    <*>
-          CF.require cfg "channel" <*>
-          CF.require cfg "nick"    <*>
-          CF.require cfg "timeout" <*>
-          pure handlerInfo         <*>
+        BotConfig                          <$>
+          CF.require cfg "server"          <*>
+          CF.require cfg "port"            <*>
+          CF.require cfg "channel"         <*>
+          (Nick <$> CF.require cfg "nick") <*>
+          CF.require cfg "timeout"         <*>
+          pure handlerInfo                 <*>
           pure cfg
 
       case eBotConfig of