Archived
1
0
Fork 0

Some API refactoring.

I can't say how I hate the Types.hs thing in Haskell!
This commit is contained in:
Julien Dessaux 2011-04-24 23:08:06 +02:00
parent d4be110200
commit 864a364da9
7 changed files with 47 additions and 51 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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