A simple IRC bot written in Haskell
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Types.hs 9.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215
  1. {-# LANGUAGE ExistentialQuantification #-}
  2. {-# LANGUAGE FlexibleContexts #-}
  3. {-# LANGUAGE MultiParamTypeClasses #-}
  4. {-# LANGUAGE RankNTypes #-}
  5. module Network.IRC.Internal.Types where
  6. import ClassyPrelude
  7. import Control.Monad.Base (MonadBase)
  8. import Control.Monad.State.Strict (StateT, MonadState, execStateT)
  9. import qualified Network.IRC.Configuration as CF
  10. import Network.IRC.Message.Types
  11. import Network.IRC.MessageBus
  12. import Network.IRC.Util
  13. -- ** Message Parsing
  14. -- | Message parser id. Should be unique.
  15. type MessageParserId = Text
  16. -- | A part of a mutlipart message.
  17. data MessagePart = MessagePart { msgPartTarget :: !Text
  18. , msgPartTime :: !UTCTime
  19. , msgPartLine :: !Text
  20. } deriving (Eq, Show)
  21. -- | The result of parsing a message line.
  22. data MessageParseResult =
  23. ParseDone !Message ![MessagePart] -- ^ A fully parsed message and leftover message parts.
  24. | ParsePartial ![MessagePart] -- ^ A partial message with message parts received yet.
  25. | ParseReject -- ^ Returned if a message line cannot be parsed by a particular parser.
  26. deriving (Eq, Show)
  27. -- | A message parser used for parsing text lines from the server to 'Message's.
  28. data MessageParser = MessageParser
  29. { msgParserId :: !MessageParserId
  30. , msgParser :: !(BotConfig -> UTCTime -> Text -> [MessagePart] -> MessageParseResult)
  31. }
  32. -- ** Command Formatting
  33. -- | A command formatter which optionally formats commands to texts which are then sent to the server.
  34. type CommandFormatter = BotConfig -> Message -> Maybe Text
  35. -- ** Bot
  36. -- | Name of a message handler.
  37. type MsgHandlerName = Text
  38. -- | The configuration for running the bot.
  39. data BotConfig = BotConfig
  40. {
  41. -- | The server to connect to.
  42. botServer :: !Text
  43. -- | The port to connect to.
  44. , botPort :: !Int
  45. -- | The channel to join.
  46. , botChannel :: !Text
  47. -- | Original nick of the bot.
  48. , botOrigNick :: !Nick
  49. -- | Current nick of the bot.
  50. , botNick :: !Nick
  51. -- | The timeout in seconds after which bot automatically disconnects and tries to reconnect.
  52. -- Should be few seconds more than the ping timeout of the server.
  53. , botTimeout :: !Int
  54. -- | Info about the message handlers. A map of message handler names to a map of all commands supported
  55. -- by that message handler to the help text of that command.
  56. , msgHandlerInfo :: !(Map MsgHandlerName (Map Text Text))
  57. -- | A map of message handler names to 'MsgHandlerMaker's which are used to create message handlers for the bot.
  58. , msgHandlerMakers :: !(Map MsgHandlerName MsgHandlerMaker)
  59. -- | A list of extra message parsers.
  60. , msgParsers :: ![MessageParser]
  61. -- | A list of extra command formatters. Note that these formatters will always be called after the built-in ones.
  62. , cmdFormatters :: ![CommandFormatter]
  63. -- | All the bot configuration so that message handlers can lookup their own specific configs.
  64. , config :: !CF.Configuration
  65. }
  66. instance Show BotConfig where
  67. show BotConfig { .. } = "BotConfig {" ++ "\n" ++
  68. "server = " ++ show botServer ++ "\n" ++
  69. "port = " ++ show botPort ++ "\n" ++
  70. "channel = " ++ show botChannel ++ "\n" ++
  71. "nick = " ++ show botNick ++ "\n" ++
  72. "timeout = " ++ show botTimeout ++ "\n" ++
  73. "handlers = " ++ show (mapKeys msgHandlerInfo) ++ " }"
  74. -- | Creates a new bot config with essential fields leaving rest of the fields empty.
  75. newBotConfig :: Text -- ^ server
  76. -> Int -- ^ port
  77. -> Text -- ^ channel
  78. -> Nick -- ^ botNick
  79. -> Int -- ^ botTimeout
  80. -> BotConfig
  81. newBotConfig server port channel botNick botTimeout =
  82. BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] (CF.fromMap mempty)
  83. -- | The bot.
  84. data Bot = Bot
  85. {
  86. -- | The config for the bot.
  87. botConfig :: !BotConfig
  88. -- | The network socket on which the bot communicates with the server.
  89. , botSocket :: !Handle
  90. -- | The message handlers attached with the bot as a map of message handler names to the message handlers.
  91. , msgHandlers :: !(Map MsgHandlerName MsgHandler)
  92. }
  93. -- | The current status of the bot.
  94. data BotStatus = Connected -- ^ Connected to the server
  95. | Disconnected -- ^ Disconnected from the server.
  96. | Joined -- ^ Joined the channel.
  97. | Kicked -- ^ Kicked from the channel.
  98. | Errored -- ^ Some unhandled error happened.
  99. | Idle -- ^ No communication with the server. The bot is idle.
  100. -- If the bot stays idle for 'botTimeout' seconds, it disconnects.
  101. | Interrupted -- ^ Interrupted using external signals like SIGINT.
  102. | NickNotAvailable -- ^ Bot's current nick is already taken on the server.
  103. | NickAvailable -- ^ Bot's original nick is available on the server.
  104. deriving (Show, Eq, Ord)
  105. -- | An IRC action to be run.
  106. newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
  107. deriving ( Functor
  108. , Applicative
  109. , Monad
  110. , MonadIO
  111. , MonadReader Bot
  112. , MonadState BotStatus
  113. )
  114. -- | Runs the bot action.
  115. runIRC :: Bot -- ^ The bot.
  116. -> BotStatus -- ^ The bot status.
  117. -> IRC a -- ^ The bot action to run.
  118. -> IO BotStatus -- ^ IO action which returns the next bot status.
  119. runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC
  120. -- ** Message handlers
  121. newtype MsgHandlerT a = MsgHandlerT { _runMsgHandler :: ReaderT BotConfig IO a }
  122. deriving ( Functor
  123. , Applicative
  124. , Monad
  125. , MonadIO
  126. , MonadBase IO
  127. , MonadReader BotConfig
  128. )
  129. -- | The monad in which message handlers actions run.
  130. class (MonadIO m, Applicative m, MonadReader BotConfig m, MonadBase IO m) => MonadMsgHandler m where
  131. fromMsgHandler :: MsgHandlerT a -> m a
  132. instance MonadMsgHandler MsgHandlerT where
  133. fromMsgHandler = id
  134. -- | A message handler containing actions which are invoked by the bot.
  135. data MsgHandler = MsgHandler
  136. {
  137. -- | The action invoked when a message is received. It returns a list of nessages in response
  138. -- which the bot sends to the server.
  139. onMessage :: !(forall m . MonadMsgHandler m => Message -> m [Message])
  140. -- | The action invoked when the message handler is stopped. Can use this for resource cleanup.
  141. , onStop :: !(forall m . MonadMsgHandler m => m ())
  142. -- | The action invoked to get the map of the commands supported by the message handler and their help messages.
  143. , handlerHelp :: !(forall m . MonadMsgHandler m => m (Map Text Text))
  144. }
  145. -- | Creates a new message handler which doesn't do anything.
  146. newMsgHandler :: MsgHandler
  147. newMsgHandler = MsgHandler
  148. { onMessage = const $ return mempty
  149. , onStop = return ()
  150. , handlerHelp = return mempty
  151. }
  152. -- | A message handler maker which creates a new message handler.
  153. data MsgHandlerMaker = MsgHandlerMaker
  154. {
  155. -- | The name of the message handler.
  156. msgHandlerName :: !MsgHandlerName
  157. -- | The action which is invoked to create a new message handler.
  158. -- Gets the bot config and the message channel used to receive messages.
  159. , msgHandlerMaker :: !(BotConfig -> MessageChannel Message -> IO MsgHandler)
  160. }
  161. instance Eq MsgHandlerMaker where
  162. m1 == m2 = msgHandlerName m1 == msgHandlerName m2
  163. instance Ord MsgHandlerMaker where
  164. m1 `compare` m2 = msgHandlerName m1 `compare` msgHandlerName m2
  165. -- | Handles a message using a given message handler.
  166. handleMessage :: MsgHandler -- ^ The message handler.
  167. -> BotConfig -- ^ The bot config.
  168. -> Message -- ^ The message to handle.
  169. -> IO [Message] -- ^ A list of commands to be sent to the server.
  170. handleMessage MsgHandler { .. } botConfig =
  171. flip runReaderT botConfig . _runMsgHandler . onMessage
  172. -- | Stops a message handler.
  173. stopMsgHandler :: MsgHandler -- ^ The message handler.
  174. -> BotConfig -- ^ The bot config.
  175. -> IO ()
  176. stopMsgHandler MsgHandler { .. } botConfig =
  177. flip runReaderT botConfig . _runMsgHandler $ onStop
  178. -- | Gets the help messages for a given message handler.
  179. getHelp :: MsgHandler -- ^ The message handler.
  180. -> BotConfig -- ^ The bot config.
  181. -> IO (Map Text Text) -- ^ A map of the commands supported by this message handler to their help messages.
  182. getHelp MsgHandler { .. } botConfig =
  183. flip runReaderT botConfig . _runMsgHandler $ handlerHelp