{-# LANGUAGE ScopedTypeVariables #-}

module ClientIO where

import qualified Control.Exception as Exception

import Control.Concurrent.Chan

import Control.Concurrent

import Control.Monad

import System.IO

import qualified Data.ByteString.UTF8 as BUTF8

import qualified Data.ByteString as B

----------------

import CoreTypes

listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()

listenLoop handle linesNumber buf chan clientID = do

    str <- liftM BUTF8.toString $ B.hGetLine handle

    if (linesNumber > 50) || (length str > 20000) then

        writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])

        else

        if str == "" then do

            writeChan chan $ ClientMessage (clientID, buf)

            yield

            listenLoop handle 0 [] chan clientID

            else

            listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID

clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()

clientRecvLoop handle chan clientID =

    listenLoop handle 0 [] chan clientID

        `catch` (\e -> clientOff (show e) >> return ())

    where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message

clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()

clientSendLoop handle coreChan chan clientID = do

    answer <- readChan chan

    doClose <- Exception.handle

        (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do

            B.hPutStrLn handle $ BUTF8.fromString $ unlines answer

            hFlush handle

            return $ isQuit answer

    if doClose then

        Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle

        else

        clientSendLoop handle coreChan chan clientID

    where

        sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])

        isQuit ("BYE":xs) = True

        isQuit _ = False