module Network.IRC.Fun.Client.IO
( Connection (..)
, Handle
, ircConnect
, ircDisconnect
, hPutIrcRaw
, hPutIrcGeneric
, hPutIrc
, hGetIrcRaw
, hGetIrcGenericOnce
, hGetIrcGenericOnce'
, hGetIrcGeneric
, hGetIrcGeneric'
, hGetIrcOnce
, hGetIrcOnce'
, hGetIrc
, hGetIrc'
)
where
import Control.Exception (bracketOnError)
import Control.Monad (liftM)
import Data.Maybe (fromMaybe)
import Network.IRC.Fun.Messages
import Network.IRC.Fun.Messages.Types
import Network.Socket
import System.IO
data Connection = Connection
{
connServer :: String
, connPort :: Int
, connTls :: Bool
, connNick :: String
, connPassword :: Maybe String
}
deriving (Eq, Show)
ircConnect :: Connection -> IO Handle
ircConnect conn = do
let hints = defaultHints
{ addrSocketType = Stream
, addrFlags = [AI_ADDRCONFIG]
}
addrs <- getAddrInfo (Just hints)
(Just $ connServer conn)
(Just $ show $ connPort conn)
let addr = head addrs
bracketOnError
(socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
(\ sock -> close sock >> putStrLn "Connection failed") $
\ sock -> do
connect sock (addrAddress addr)
handle <- socketToHandle sock ReadWriteMode
hSetBuffering handle LineBuffering
encoding <- mkTextEncoding "UTF-8//TRANSLIT"
hSetEncoding handle encoding
hSetNewlineMode handle (NewlineMode CRLF CRLF)
return handle
ircDisconnect :: Handle -> IO ()
ircDisconnect = hClose
hPutIrcRaw :: Handle -> String -> IO ()
hPutIrcRaw = hPutStrLn
hPutIrcGeneric :: Handle -> GenericMessage -> IO ()
hPutIrcGeneric h = hPutIrcRaw h . serializeMessage
hPutIrc :: Handle -> Message -> IO ()
hPutIrc h = hPutIrcGeneric h . buildMessage . SpecificMessage Nothing
hGetIrcRaw :: Handle -> IO String
hGetIrcRaw = hGetLine
hGetIrcGenericOnce :: Handle -> IO (Maybe GenericMessage)
hGetIrcGenericOnce h = liftM parseMessage $ hGetIrcRaw h
hGetIrcGenericOnce' :: Handle -> IO (Either String GenericMessage)
hGetIrcGenericOnce' h = do
line <- hGetIrcRaw h
return $ case parseMessage line of
Just msg -> Right msg
Nothing -> Left line
hGetIrcGeneric :: Handle -> IO GenericMessage
hGetIrcGeneric h = hGetIrcGenericOnce h >>= maybe (hGetIrcGeneric h) return
hGetIrcGeneric' :: Handle -> IO ([String], GenericMessage)
hGetIrcGeneric' h = do
(l, gm) <- f []
return (reverse l, gm)
where
f errs = do
res <- hGetIrcGenericOnce' h
case res of
Left s -> f $ s : errs
Right gm -> return (errs, gm)
hGetIrcOnce :: Handle -> IO (Maybe (Either SpecificReply SpecificMessage))
hGetIrcOnce h = hGetIrcGenericOnce h >>=
return . maybe Nothing ((either (const Nothing) Just) . analyze)
hGetIrcOnce' :: Handle
-> IO (Either String (Either SpecificReply SpecificMessage))
hGetIrcOnce' h = do
res <- hGetIrcGenericOnce' h
return $ case res of
Left s -> Left s
Right gm ->
case analyze gm of
Left err -> Left $ err ++ " : " ++ show gm
Right spec -> Right spec
hGetIrc :: Handle -> IO (Either SpecificReply SpecificMessage)
hGetIrc h = hGetIrcOnce h >>= maybe (hGetIrc h) return
hGetIrc' :: Handle -> IO ([String], Either SpecificReply SpecificMessage)
hGetIrc' h = do
(l, m) <- f []
return (reverse l, m)
where
f errs = do
res <- hGetIrcOnce' h
case res of
Left s -> f $ s : errs
Right m -> return (errs, m)