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 System.Log.Logger
import Hsbot.Config
import Hsbot.Core
import Hsbot.Types

View file

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

View file

@ -19,7 +19,6 @@ import Prelude hiding (catch)
import System.IO
import System.Log.Logger
import Hsbot.Config
import Hsbot.Types
import Hsbot.Utils

View file

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

View file

@ -11,7 +11,6 @@ import Prelude hiding (catch)
import Hsbot.Message
import Hsbot.Types
import Hsbot.Utils
pingId :: PluginId
pingId = PluginId

View file

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

View file

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