Some API refactoring.
I can't say how I hate the Types.hs thing in Haskell!
This commit is contained in:
parent
d4be110200
commit
864a364da9
7 changed files with 47 additions and 51 deletions
1
Hsbot.hs
1
Hsbot.hs
|
@ -7,7 +7,6 @@ import Config.Dyre.Relaunch
|
|||
import Control.Monad.Reader
|
||||
import System.Log.Logger
|
||||
|
||||
import Hsbot.Config
|
||||
import Hsbot.Core
|
||||
import Hsbot.Types
|
||||
|
||||
|
|
|
@ -1,28 +1,14 @@
|
|||
module Hsbot.Config
|
||||
( Config (..)
|
||||
, TLSConfig (..)
|
||||
, defaultConfig
|
||||
( defaultConfig
|
||||
, defaultTLSConfig
|
||||
, noSSL
|
||||
) where
|
||||
|
||||
import Control.Concurrent.Chan
|
||||
import Network
|
||||
import qualified Network.IRC as IRC
|
||||
import Network.TLS
|
||||
import Network.TLS.Extra
|
||||
|
||||
import Hsbot.Message
|
||||
data Config = Config
|
||||
{ configErrors :: Maybe String
|
||||
, configTLS :: TLSConfig
|
||||
, configAddress :: String
|
||||
, configPort :: PortID
|
||||
, configChannels :: [String]
|
||||
, configNicknames :: [String]
|
||||
, configRealname :: String
|
||||
, configPlugins :: [(String, Chan Message -> Chan Message -> IO ())]
|
||||
}
|
||||
import Hsbot.Types
|
||||
|
||||
defaultConfig :: Config
|
||||
defaultConfig = Config
|
||||
|
@ -35,15 +21,6 @@ defaultConfig = Config
|
|||
, configRealname = "The One True bot, with it's haskell soul."
|
||||
, configPlugins = [] }
|
||||
|
||||
data TLSConfig = TLSConfig
|
||||
{ sslOn :: Bool
|
||||
, sslCert :: String
|
||||
, sslKey :: String
|
||||
, sslVersions :: [Network.TLS.Version]
|
||||
, sslCiphers :: [Network.TLS.Cipher]
|
||||
, sslVerify :: Bool
|
||||
} deriving (Show)
|
||||
|
||||
defaultTLSConfig :: TLSConfig
|
||||
defaultTLSConfig = TLSConfig
|
||||
{ sslOn = True
|
||||
|
|
|
@ -19,7 +19,6 @@ import Prelude hiding (catch)
|
|||
import System.IO
|
||||
import System.Log.Logger
|
||||
|
||||
import Hsbot.Config
|
||||
import Hsbot.Types
|
||||
import Hsbot.Utils
|
||||
|
||||
|
|
|
@ -1,9 +1,21 @@
|
|||
module Hsbot.Message
|
||||
( Message (..)
|
||||
( readMsg
|
||||
, writeMsg
|
||||
) where
|
||||
|
||||
import qualified Network.IRC as IRC
|
||||
import Control.Concurrent
|
||||
import Control.Monad.State
|
||||
|
||||
data Message = IncomingMsg IRC.Message
|
||||
| OutgoingMsg IRC.Message
|
||||
import Hsbot.Types
|
||||
|
||||
-- Plugin Utils
|
||||
readMsg :: Plugin IO (Message)
|
||||
readMsg = do
|
||||
chan <- gets pluginChan
|
||||
liftIO $ readChan chan >>= return
|
||||
|
||||
writeMsg :: Message -> Plugin IO ()
|
||||
writeMsg msg = do
|
||||
chan <- gets pluginMaster
|
||||
liftIO $ writeChan chan msg
|
||||
|
||||
|
|
|
@ -11,7 +11,6 @@ import Prelude hiding (catch)
|
|||
|
||||
import Hsbot.Message
|
||||
import Hsbot.Types
|
||||
import Hsbot.Utils
|
||||
|
||||
pingId :: PluginId
|
||||
pingId = PluginId
|
||||
|
|
|
@ -3,23 +3,24 @@ module Hsbot.Types
|
|||
, BotState (..)
|
||||
, BotStatus (..)
|
||||
, BotEnv (..)
|
||||
, Config (..)
|
||||
, Env
|
||||
, Message (..)
|
||||
, Plugin
|
||||
, PluginId (..)
|
||||
, PluginState (..)
|
||||
, TLSConfig (..)
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Network
|
||||
import qualified Network.IRC as IRC
|
||||
import Network.TLS
|
||||
import System.IO
|
||||
|
||||
import Hsbot.Config
|
||||
import Hsbot.Message
|
||||
|
||||
-- The bot environment
|
||||
type Env = ReaderT BotEnv
|
||||
|
||||
|
@ -57,5 +58,30 @@ data PluginId = PluginId
|
|||
, pluginEp :: PluginState -> IO ()
|
||||
}
|
||||
|
||||
-- Messaging
|
||||
data Message = IncomingMsg IRC.Message
|
||||
| OutgoingMsg IRC.Message
|
||||
|
||||
data BotStatus = BotContinue | BotExit | BotReload | BotRestart deriving (Show)
|
||||
|
||||
-- Config
|
||||
data Config = Config
|
||||
{ configErrors :: Maybe String
|
||||
, configTLS :: TLSConfig
|
||||
, configAddress :: String
|
||||
, configPort :: PortID
|
||||
, configChannels :: [String]
|
||||
, configNicknames :: [String]
|
||||
, configRealname :: String
|
||||
, configPlugins :: [(String, Chan Message -> Chan Message -> IO ())]
|
||||
}
|
||||
|
||||
data TLSConfig = TLSConfig
|
||||
{ sslOn :: Bool
|
||||
, sslCert :: String
|
||||
, sslKey :: String
|
||||
, sslVersions :: [Network.TLS.Version]
|
||||
, sslCiphers :: [Network.TLS.Cipher]
|
||||
, sslVerify :: Bool
|
||||
} deriving (Show)
|
||||
|
||||
|
|
|
@ -4,16 +4,13 @@ module Hsbot.Utils
|
|||
, first
|
||||
, initTLSEnv
|
||||
, readCertificate
|
||||
, readMsg
|
||||
, readPrivateKey
|
||||
, sendStr
|
||||
, setGlobalQuitMVar
|
||||
, writeMsg
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import qualified Crypto.Cipher.RSA as RSA
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
|
@ -25,8 +22,6 @@ import Data.List
|
|||
import Network.TLS
|
||||
import System.IO
|
||||
|
||||
import Hsbot.Config
|
||||
import Hsbot.Message
|
||||
import Hsbot.Types
|
||||
|
||||
-- utility functions
|
||||
|
@ -53,17 +48,6 @@ sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
|
|||
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
|
||||
sendStr handle Nothing msg = hPutStrLn handle msg
|
||||
|
||||
-- Plugin Utils
|
||||
readMsg :: Plugin IO (Message)
|
||||
readMsg = do
|
||||
chan <- gets pluginChan
|
||||
liftIO $ readChan chan >>= return
|
||||
|
||||
writeMsg :: Message -> Plugin IO ()
|
||||
writeMsg msg = do
|
||||
chan <- gets pluginMaster
|
||||
liftIO $ writeChan chan msg
|
||||
|
||||
-- TLS utils
|
||||
initTLSEnv :: TLSConfig -> IO (TLSParams)
|
||||
initTLSEnv ssl = do
|
||||
|
|
Reference in a new issue