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 Control.Monad.Reader
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
|
|
||||||
import Hsbot.Config
|
|
||||||
import Hsbot.Core
|
import Hsbot.Core
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
|
|
||||||
|
|
|
@ -1,28 +1,14 @@
|
||||||
module Hsbot.Config
|
module Hsbot.Config
|
||||||
( Config (..)
|
( defaultConfig
|
||||||
, TLSConfig (..)
|
|
||||||
, defaultConfig
|
|
||||||
, defaultTLSConfig
|
, defaultTLSConfig
|
||||||
, noSSL
|
, noSSL
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.Chan
|
|
||||||
import Network
|
import Network
|
||||||
import qualified Network.IRC as IRC
|
|
||||||
import Network.TLS
|
import Network.TLS
|
||||||
import Network.TLS.Extra
|
import Network.TLS.Extra
|
||||||
|
|
||||||
import Hsbot.Message
|
import Hsbot.Types
|
||||||
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 ())]
|
|
||||||
}
|
|
||||||
|
|
||||||
defaultConfig :: Config
|
defaultConfig :: Config
|
||||||
defaultConfig = Config
|
defaultConfig = Config
|
||||||
|
@ -35,15 +21,6 @@ defaultConfig = Config
|
||||||
, configRealname = "The One True bot, with it's haskell soul."
|
, configRealname = "The One True bot, with it's haskell soul."
|
||||||
, configPlugins = [] }
|
, 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
|
||||||
defaultTLSConfig = TLSConfig
|
defaultTLSConfig = TLSConfig
|
||||||
{ sslOn = True
|
{ sslOn = True
|
||||||
|
|
|
@ -19,7 +19,6 @@ import Prelude hiding (catch)
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
|
|
||||||
import Hsbot.Config
|
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
import Hsbot.Utils
|
import Hsbot.Utils
|
||||||
|
|
||||||
|
|
|
@ -1,9 +1,21 @@
|
||||||
module Hsbot.Message
|
module Hsbot.Message
|
||||||
( Message (..)
|
( readMsg
|
||||||
|
, writeMsg
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Network.IRC as IRC
|
import Control.Concurrent
|
||||||
|
import Control.Monad.State
|
||||||
|
|
||||||
data Message = IncomingMsg IRC.Message
|
import Hsbot.Types
|
||||||
| OutgoingMsg IRC.Message
|
|
||||||
|
-- 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.Message
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
import Hsbot.Utils
|
|
||||||
|
|
||||||
pingId :: PluginId
|
pingId :: PluginId
|
||||||
pingId = PluginId
|
pingId = PluginId
|
||||||
|
|
|
@ -3,23 +3,24 @@ module Hsbot.Types
|
||||||
, BotState (..)
|
, BotState (..)
|
||||||
, BotStatus (..)
|
, BotStatus (..)
|
||||||
, BotEnv (..)
|
, BotEnv (..)
|
||||||
|
, Config (..)
|
||||||
, Env
|
, Env
|
||||||
, Message (..)
|
, Message (..)
|
||||||
, Plugin
|
, Plugin
|
||||||
, PluginId (..)
|
, PluginId (..)
|
||||||
, PluginState (..)
|
, PluginState (..)
|
||||||
|
, TLSConfig (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Network
|
||||||
|
import qualified Network.IRC as IRC
|
||||||
import Network.TLS
|
import Network.TLS
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import Hsbot.Config
|
|
||||||
import Hsbot.Message
|
|
||||||
|
|
||||||
-- The bot environment
|
-- The bot environment
|
||||||
type Env = ReaderT BotEnv
|
type Env = ReaderT BotEnv
|
||||||
|
|
||||||
|
@ -57,5 +58,30 @@ data PluginId = PluginId
|
||||||
, pluginEp :: PluginState -> IO ()
|
, pluginEp :: PluginState -> IO ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- Messaging
|
||||||
|
data Message = IncomingMsg IRC.Message
|
||||||
|
| OutgoingMsg IRC.Message
|
||||||
|
|
||||||
data BotStatus = BotContinue | BotExit | BotReload | BotRestart deriving (Show)
|
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
|
, first
|
||||||
, initTLSEnv
|
, initTLSEnv
|
||||||
, readCertificate
|
, readCertificate
|
||||||
, readMsg
|
|
||||||
, readPrivateKey
|
, readPrivateKey
|
||||||
, sendStr
|
, sendStr
|
||||||
, setGlobalQuitMVar
|
, setGlobalQuitMVar
|
||||||
, writeMsg
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
|
||||||
import qualified Crypto.Cipher.RSA as RSA
|
import qualified Crypto.Cipher.RSA as RSA
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Char8 as C
|
import qualified Data.ByteString.Char8 as C
|
||||||
|
@ -25,8 +22,6 @@ import Data.List
|
||||||
import Network.TLS
|
import Network.TLS
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import Hsbot.Config
|
|
||||||
import Hsbot.Message
|
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
|
|
||||||
-- utility functions
|
-- utility functions
|
||||||
|
@ -53,17 +48,6 @@ sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
|
||||||
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
|
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
|
||||||
sendStr handle Nothing msg = hPutStrLn handle 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
|
-- TLS utils
|
||||||
initTLSEnv :: TLSConfig -> IO (TLSParams)
|
initTLSEnv :: TLSConfig -> IO (TLSParams)
|
||||||
initTLSEnv ssl = do
|
initTLSEnv ssl = do
|
||||||
|
|
Reference in a new issue