IO.hs

{- This file is part of irc-fun-client.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

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

-- | Details of the connection to IRC.
data Connection = Connection
    { -- | IRC Server address, e.g. @"irc.freenode.net"@
      server   :: String
      -- | IRC server port, @6667@ should be a safe default
    , port     :: Int
      -- | Whether to make an encrypted connection via TLS (not implemented)
    , tls      :: Bool
      -- | IRC nickname for the bot, e.g. @"funbot"@
    , nick     :: String
    -- | Connection password, use if the nickname is registered
    , password :: Maybe String
    }
    deriving (Eq, Show)

-- | Connect to an IRC server using the given connection parameters, and return
-- a handle to the open socket. This just opens a TCP connection, without
-- sending any IRC commands.
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

-- | Disconnect from IRC by closing the client's side of the connection. This
-- function is mainly provided for completeness. You should probably use the
-- QUIT command of IRC to quit the network in a manner coordinated with the
-- server.
ircDisconnect :: Handle -> IO ()
ircDisconnect = hClose

-- | Send an IRC command, given in string form, to the server. The given
-- command string shouldn't contain any newlines.
hPutIrcRaw :: Handle -> String -> IO ()
hPutIrcRaw = hPutStrLn

-- | Send an IRC message represented in generic form to the server.
hPutIrcGeneric :: Handle -> GenericMessage -> IO ()
hPutIrcGeneric h = hPutIrcRaw h . serializeMessage

-- | Send an IRC message to the server.
hPutIrc :: Handle -> Message -> IO ()
hPutIrc h = hPutIrcGeneric h . buildMessage . SpecificMessage Nothing

-- | Receive an IRC message, given in string form, from the server. The
-- resulting string won't contain newlines.
hGetIrcRaw :: Handle -> IO String
hGetIrcRaw = hGetLine

-- | Receive an IRC message in generic form from the server. If parsing the
-- message read from the server fails, 'Nothing' is returned.
hGetIrcGenericOnce :: Handle -> IO (Maybe GenericMessage)
hGetIrcGenericOnce h = hGetIrcRaw h >>= return . parseMessage

-- | Receive the next valid (successfully parsed) IRC message in generic form
-- from the server.
hGetIrcGeneric :: Handle -> IO GenericMessage
hGetIrcGeneric h = hGetIrcGenericOnce h >>= maybe (hGetIrcGeneric h) return

-- | Receive an IRC message from the server. If parsing the message read from
-- the server fails, 'Nothing' is returned.
hGetIrcOnce :: Handle -> IO (Maybe (Either SpecificReply SpecificMessage))
hGetIrcOnce h = hGetIrcGenericOnce h >>=
    return . maybe Nothing ((either (const Nothing) Just) .  analyze)

-- | Receive the next valid (successfully parsed) IRC message from the server.
hGetIrc :: Handle -> IO (Either SpecificReply SpecificMessage)
hGetIrc h = hGetIrcOnce h >>= maybe (hGetIrc h) return