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/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Network.IRC.Fun.Client.IO
    ( ConnConfig ()
    , defConnConfig
    , connServer
    , connPort
    , connTls
    , connNickname
    , connPassword
    , ConnContext ()
    , initConnContext
    , Connection ()
    , ircConnect
    , ircDisconnect
    , hPutIrcRaw
    , hPutIrcGeneric
    , hPutIrc
    , Result (..)
    , hGetIrcRaw
    , hGetIrcGenericOnce
    , hGetIrcGeneric
    , hGetIrcOnce
    , hGetIrc
    )
where

import Control.Exception (bracketOnError)
import Control.Monad (liftM)
import Data.ByteString.Char8 (ByteString, unsnoc)
import Data.Default.Class
import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Network.IRC.Fun.Messages
import Network.IRC.Fun.Types

import qualified Network.Connection as NC

-- | Details of the connection to IRC.
data ConnConfig = ConnConfig
    { -- | IRC Server address, e.g. @"irc.freenode.net"@. It may also be an IP
      -- address.
      connServer   :: Hostname
      -- | IRC server port, @6667@ should be a safe default
    , connPort     :: PortNumber
      -- | Whether to make an encrypted connection via TLS
    , connTls      :: Bool
      -- | IRC nickname for the bot, e.g. @"funbot"@
    , connNickname :: Nickname
    -- | Connection password, use if the nickname is registered
    , connPassword :: Maybe Password
    }
    deriving (Eq, Show)

instance Default ConnConfig where
    def = ConnConfig
        { connServer   = Hostname "irc.freenode.net"
        , connPort     = PortNumber 6667
        , connTls      = False
        , connNickname = Nickname "rand0m-n1ck"
        , connPassword = Nothing
        }

-- | TODO
defConnConfig :: ConnConfig
defConnConfig = def

-- | TODO
newtype ConnContext = ConnContext { unCtx :: NC.ConnectionContext }

-- | TODO
initConnContext :: IO ConnContext
initConnContext = fmap ConnContext NC.initConnectionContext

-- | TODO
newtype Connection = Connection { unConn :: NC.Connection }

-- | 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 :: ConnContext -> ConnConfig -> IO Connection
ircConnect ctx cfg = do
    let params = NC.ConnectionParams
            { NC.connectionHostname =
                unpack $ unHostname $ connServer cfg
            , NC.connectionPort =
                fromInteger $ toInteger $ unPortNumber $ connPort cfg
            , NC.connectionUseSecure =
                if connTls cfg
                    then Just def
                    else Nothing
            , NC.connectionUseSocks =
                Nothing
            }
    bracketOnError
        (NC.connectTo (unCtx ctx) params)
        (\ conn -> NC.connectionClose conn >> putStrLn "Connection closed")
        (return . Connection)

-- | 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 :: Connection -> IO ()
ircDisconnect = NC.connectionClose . unConn

decode :: ByteString -> Text
decode = decodeUtf8With lenientDecode

encode :: Text -> ByteString
encode = encodeUtf8

-- | Send an IRC command, given in string form, to the server. The given
-- command string shouldn't contain any newlines.
hPutIrcRaw :: Connection -> Text -> IO ()
hPutIrcRaw c = NC.connectionPut (unConn c) . encode

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

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

-- | Result of receiving a message from an IRC server and examining it.
data Result
    -- | Parsing the text line received into a generic IRC protocol message
    -- failed. The text line received is provided.
    = ParsingFailed Text
    -- | Parsing succeeded, but analyzing the message into a recognized IRC
    -- command failed. The successfully parsed message and an analysis error
    -- message are provided.
    | AnalysisFailed GenericMessage Text
    -- | Successfully received and IRC reply.
    | GotReply SpecificReply
    -- | Successfully received an IRC message (named command).
    | GotMessage SpecificMessage

-- | Receive an IRC message, given in string form, from the server. The
-- resulting string won't contain newlines.
hGetIrcRaw :: Connection -> IO Text
hGetIrcRaw c = do
    bs <- NC.connectionGetLine 4096 (unConn c)
    let bs' =
            case unsnoc bs of
                Just (s, '\r') -> s
                _              -> bs
    return $ decode bs'

-- | Receive an IRC message in generic form from the server. If parsing the
-- message read from the server fails, the plain message text is returned.
hGetIrcGenericOnce :: Connection -> IO (Either Text GenericMessage)
hGetIrcGenericOnce c = do
    line <- hGetIrcRaw c
    return $ case parseMessage line of
        Just msg -> Right msg
        Nothing  -> Left line

-- | Receive the next valid (successfully parsed) IRC message in generic form
-- from the server, and a list of erronous IRC lines received before it, if
-- there are any.
hGetIrcGeneric :: Connection -> IO ([Text], GenericMessage)
hGetIrcGeneric c = do
    (l, gm) <- f []
    return (reverse l, gm)
    where
    f errs = do
        res <- hGetIrcGenericOnce c
        case res of
            Left s   -> f $ s : errs
            Right gm -> return (errs, gm)

-- | Receive an IRC message from the server.
hGetIrcOnce :: Connection -> IO Result
hGetIrcOnce c = do
    res <- hGetIrcGenericOnce c
    return $ case res of
        Left t   -> ParsingFailed t
        Right gm ->
            case analyze gm of
                Left err   -> AnalysisFailed gm err
                Right spec -> either GotReply GotMessage spec

-- | Receive the next valid (successfully analyzed) IRC message from the
-- server, and a list of error messages and IRC lines whose parsing failed,
-- received before it, if any. A 'Left' failure item is a plain text IRC line
-- received whose parsing has failed, and a 'Right' failure item is a generic
-- message (i.e. parsing succeeded) whose analysis has failed, and it is
-- provided along with an error description.
hGetIrc
    :: Connection
    -> IO ( [Either Text (GenericMessage, Text)]
          , Either SpecificReply SpecificMessage
          )
hGetIrc c = do
    (l, m) <- f []
    return (reverse l, m)
    where
    f errs = do
        res <- hGetIrcOnce c
        case res of
            ParsingFailed t       -> f $ Left t          : errs
            AnalysisFailed gm err -> f $ Right (gm, err) : errs
            GotReply sr           -> return (errs, Left sr)
            GotMessage sm         -> return (errs, Right sm)