module Network.IRC.Fun.Client.IO
( Connection (..)
, Handle
, ircConnect
, ircDisconnect
, hPutIrcRaw
, hPutIrcGeneric
, hPutIrc
, hGetIrcRaw
, hGetIrcGenericOnce
, hGetIrcGeneric
, hGetIrcOnce
, hGetIrc
)
where
import Control.Exception (bracketOnError)
import Data.Maybe (fromMaybe)
import Network.IRC.Fun.Messages
import Network.IRC.Fun.Messages.Types
import Network.Socket
import System.IO
data Connection = Connection
{
server :: String
, port :: Int
, tls :: Bool
, nick :: String
, password :: 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 $ server conn)
(Just $ show $ port 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 = hGetIrcRaw h >>= return . parseMessage
hGetIrcGeneric :: Handle -> IO GenericMessage
hGetIrcGeneric h = hGetIrcGenericOnce h >>= maybe (hGetIrcGeneric h) return
hGetIrcOnce :: Handle -> IO (Maybe (Either SpecificReply SpecificMessage))
hGetIrcOnce h = hGetIrcGenericOnce h >>=
return . maybe Nothing ((either (const Nothing) Just) . analyze)
hGetIrc :: Handle -> IO (Either SpecificReply SpecificMessage)
hGetIrc h = hGetIrcOnce h >>= maybe (hGetIrc h) return