module Hsbot.Core
    ( initHsbot
    , runHsbot
    , terminateHsbot
    ) where

import Control.Concurrent
import Control.Exception (IOException, catch)
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
import Network
import qualified Network.IRC as IRC
import Network.BSD (getHostName)
import Network.TLS
import Prelude hiding (catch)
import System.IO
import System.Log.Logger

import Hsbot.Types
import Hsbot.Utils

initHsbot :: Config -> IO (BotEnv)
initHsbot config = do
    chan <- newChan :: IO (Chan Message)
    threadIdsMv <- newMVar []
    quitMv <- newEmptyMVar
    let hostname = configAddress config
        port = configPort config
    infoM "Hsbot.Core" $ "Connecting to " ++ hostname -- ++ ":" ++ port
    connhdl <- connectTo hostname port
    hSetBuffering connhdl LineBuffering
    hSetEncoding connhdl utf8
    (tls, tlsCtx) <- case sslOn $ configTLS config of
        True  -> do
            infoM "Hsbot.Core" "TLS init"
            tlsenv <- initTLSEnv (configTLS config)
            randomGen <- makeSRandomGen >>= either (fail . show) (return . id)
            sCtx <- client tlsenv randomGen connhdl
            handshake sCtx
            return (Just tlsenv, Just sCtx)
        False -> return (Nothing, Nothing)
    return BotEnv { envHandle      = connhdl
                  , envChan        = chan
                  , envQuitMv      = quitMv
                  , envThreadIdsMv = threadIdsMv
                  , envConfig      = config
                  , envTLS         = tls
                  , envTLSCtx      = tlsCtx }

runHsbot :: Env IO (BotStatus)
runHsbot = do
    let bot = BotState { botPlugins  = M.empty
                       , botHooks    = []
                       , botChannels = []
                       , botNickname = [] }
    evalStateT trueRunHsbot bot
  where
    trueRunHsbot :: Bot (Env IO) (BotStatus)
    trueRunHsbot = do
        -- First we say hello
        env <- lift ask
        hostname <- liftIO getHostName
        let connhdl  = envHandle env
            tlsCtx   = envTLSCtx env
            config   = envConfig env
            nickname = head $ configNicknames config
            channels = configChannels config
        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.nick nickname
        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
        mapM_ (liftIO . sendStr connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
        -- Next we spawn the reader thread
        liftIO $ debugM "Hsbot.Core" $ "Spawning reader thread"
        myOwnThreadId  <- liftIO $ myThreadId
        chan <- lift $ asks envChan
        (liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= lift . addThreadIdToQuitMVar
        -- Then we spawn all plugins
        -- asks envSocket  >>= mapM_ ( ----- what's next? the core server handling! ----- )
        -- Finally we spawn the main bot loop
        bot <- get
        finalStateMVar <- liftIO newEmptyMVar
        (liftIO . forkIO $ runReaderT (execStateT botLoop bot >>= storeFinalState finalStateMVar) env) >>= lift . addThreadIdToQuitMVar
        -- We wait for the quit signal
        code <- asks envQuitMv >>= liftIO . takeMVar
        -- and we clean things up
        asks envThreadIdsMv >>= liftIO . readMVar >>= liftIO . mapM_ killThread
        return code
    storeFinalState :: MVar BotState -> BotState -> Env IO ()
    storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState

botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
botReader _ (Just ctx) chan _ = forever $
    recvData ctx >>= return . L.toChunks >>= mapM_ (handleIncomingStr chan . C.unpack)  -- TODO exceptions
botReader handle Nothing chan fatherThreadId = forever $
    (hGetLine handle) `catch` handleIOException >>= handleIncomingStr chan
  where
    handleIOException :: IOException -> IO (String)
    handleIOException ioException = do
        throwTo fatherThreadId ioException
        myId <- myThreadId
        killThread myId
        return ""

botLoop :: Bot (Env IO) ()
botLoop = do
    chan <- lift $ asks envChan
    hooks <- gets botHooks
    msg  <- liftIO $ readChan chan
    mapM_ (liftIO . flip writeChan msg) hooks
    case msg of
        IncomingMsg _ -> return () -- TODO parse for core commands
        OutgoingMsg outMsg -> do
            env <- lift ask
            let connhdl  = envHandle env
                tlsCtx   = envTLSCtx env
            liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg

handleIncomingStr :: Chan Message -> String -> IO ()
handleIncomingStr chan str = do
    case IRC.decode str of
        Just msg -> do
            debugM "Ircd.Reader" $ "<-- " ++ (show msg)
            writeChan chan $ IncomingMsg msg
        Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str     -- TODO: spam control

terminateHsbot :: Env IO ()
terminateHsbot = do
    liftIO $ infoM "Hsbot.Core" "Closing connection"
    asks envHandle >>= liftIO . hClose