{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RecordWildCards            #-}

-- | Wrapping of @libtelnet@ types.

module Network.Telnet.LibTelnet.Types where

import Network.Telnet.LibTelnet.Iac
import Network.Telnet.LibTelnet.Options

import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)
import Foreign
import Foreign.C
import GHC.Generics (Generic)

#include <libtelnet.h>

-- | Uninhabited type for pointer safety (@telnet_t@).
data TelnetT

-- | Exceptions thrown by the binding, for when something has gone
-- seriously wrong. Errors detected by @libtelnet@ are not thrown but
-- instead are passed to the event handler.
data TelnetException
  = NullTelnetPtr
  | UnexpectedEventType TelnetEventTypeT
  | UnexpectedEnvironCmd ECmd
  | UnexpectedEnvironVar EVar
  | UnexpectedTerminalTypeCmd TCmd
  deriving (Eq, Generic, Show, Typeable)

instance Exception TelnetException

-- | Flags for @telnet_init@.
newtype Flag = Flag { unFlag :: CUChar }
#{enum Flag, Flag
 , flagProxy = TELNET_FLAG_PROXY
 }

-- | Wraps @telnet_telopt_t@.
data TelnetTeloptT = TelnetTeloptT
  { _telopt :: CShort -- ^ option value
  , _us :: Iac -- ^ option supported on server
  , _him :: Iac -- ^ allow clients to use the option?
  }

instance Storable TelnetTeloptT where
  sizeOf _ = (#size telnet_telopt_t)
  alignment _ = (#alignment telnet_telopt_t)

  peek p = do
    telopt <- (#peek telnet_telopt_t, telopt) p
    us <- (#peek telnet_telopt_t, us) p
    him <- (#peek telnet_telopt_t, him) p

    pure $ TelnetTeloptT telopt us him

  poke p TelnetTeloptT{..} = do
    (#poke telnet_telopt_t, telopt) p _telopt
    (#poke telnet_telopt_t, us) p _us
    (#poke telnet_telopt_t, him) p _him

-- | Wraps @telnet_event_t@.
data EventT
  = Data (CString, CSize) -- ^ 'eventData'
  | Send (CString, CSize) -- ^ 'eventSend'
  | Warning ErrorT -- ^ 'eventWarning'
  | Error ErrorT -- ^ 'eventError'
  | Command Iac -- ^ 'eventIac'
  | Will Option -- ^ 'eventWill'
  | Wont Option -- ^ 'eventWont'
  | Do Option -- ^ 'eventDo'
  | Dont Option -- ^ 'eventDont'
  | Subnegotiation Option (CString, CSize) -- ^ 'eventSubnegotiation'
  | Zmp (Ptr CString, CSize) -- ^ 'eventZmp'
  | TerminalType TCmd CString -- ^ 'eventTType'
  | Compress CUChar -- ^ 'eventCompress'
  | Environ ECmd (Ptr TelnetEnvironT, CSize) -- ^ 'eventEnviron'
  | Mssp (Ptr TelnetEnvironT, CSize) -- ^ 'eventMssp'

instance Storable EventT where
  sizeOf _ = (#size telnet_event_t)
  alignment _ = (#alignment telnet_event_t)

  peek p = do
    eType <- (#peek telnet_event_t, type) p
    if | eType `elem` [eventData, eventSend] -> do
           ctor <- if | eType == eventData -> pure Data
                      | eType == eventSend -> pure Send
                      | otherwise -> throwIO $ UnexpectedEventType eType
           buffer <- (#peek telnet_event_t, data.buffer) p
           size <- (#peek telnet_event_t, data.size) p
           pure $ ctor (buffer, size)

       | eType `elem` [eventWarning, eventError] -> do
           ctor <- if | eType == eventWarning -> pure Warning
                      | eType == eventError -> pure Error
                      | otherwise -> throwIO $ UnexpectedEventType eType
           file <- (#peek telnet_event_t, error.file) p
           func <- (#peek telnet_event_t, error.func) p
           msg <- (#peek telnet_event_t, error.msg) p
           line <- (#peek telnet_event_t, error.line) p
           errcode <- (#peek telnet_event_t, error.errcode) p

           pure . ctor $ ErrorT file func msg line errcode

       | eType == eventIac ->
           Command <$> (#peek telnet_event_t, iac.cmd) p

       | eType `elem` [eventWill, eventWont, eventDo, eventDont] -> do
           ctor <- if | eType == eventWill -> pure Will
                      | eType == eventWont -> pure Wont
                      | eType == eventDo -> pure Do
                      | eType == eventDont -> pure Dont
                      | otherwise -> throwIO $ UnexpectedEventType eType
           ctor <$> (#peek telnet_event_t, neg.telopt) p

       | eType == eventSubnegotiation -> do
           telopt <- (#peek telnet_event_t, sub.telopt) p
           buffer <- (#peek telnet_event_t, sub.buffer) p
           size <- (#peek telnet_event_t, sub.size) p

           pure $ Subnegotiation telopt (buffer, size)

       | eType == eventZmp -> do
           argc <- (#peek telnet_event_t, zmp.argc) p
           argv <- (#peek telnet_event_t, zmp.argv) p

           pure $ Zmp (argv, argc)

       | eType == eventTType -> do
           cmd <- (#peek telnet_event_t, ttype.cmd) p
           name <- (#peek telnet_event_t, ttype.name) p

           pure $ TerminalType cmd name

       | eType == eventCompress ->
           Compress <$> (#peek telnet_event_t, compress.state) p

       | eType == eventEnviron -> do
           cmd <- (#peek telnet_event_t, environ.cmd) p
           values <- (#peek telnet_event_t, environ.values) p
           size <- (#peek telnet_event_t, environ.size) p

           pure $ Environ cmd (values, size)

       | eType == eventMssp -> do
           values <- (#peek telnet_event_t, mssp.values) p
           size <- (#peek telnet_event_t, mssp.size) p

           pure $ Mssp (values, size)

       | otherwise -> throwIO $ UnexpectedEventType eType

  poke p (Data (buffer, size)) = do
    (#poke telnet_event_t, type) p eventData
    (#poke telnet_event_t, data.buffer) p buffer
    (#poke telnet_event_t, data.size) p size

  poke p (Send (buffer, size)) = do
    (#poke telnet_event_t, type) p eventSend
    (#poke telnet_event_t, data.buffer) p buffer
    (#poke telnet_event_t, data.size) p size

  poke p (Warning ErrorT{..}) = do
    (#poke telnet_event_t, type) p eventWarning
    (#poke telnet_event_t, error.file) p _file
    (#poke telnet_event_t, error.func) p _func
    (#poke telnet_event_t, error.msg) p _msg
    (#poke telnet_event_t, error.line) p _line
    (#poke telnet_event_t, error.errcode) p _errcode

  poke p (Error ErrorT{..}) = do
    (#poke telnet_event_t, type) p eventError
    (#poke telnet_event_t, error.file) p _file
    (#poke telnet_event_t, error.func) p _func
    (#poke telnet_event_t, error.msg) p _msg
    (#poke telnet_event_t, error.line) p _line
    (#poke telnet_event_t, error.errcode) p _errcode

  poke p (Command cmd) = do
    (#poke telnet_event_t, type) p eventIac
    (#poke telnet_event_t, iac.cmd) p cmd

  poke p (Will opt) = do
    (#poke telnet_event_t, type) p eventWill
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Wont opt) = do
    (#poke telnet_event_t, type) p eventWont
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Do opt) = do
    (#poke telnet_event_t, type) p eventDo
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Dont opt) = do
    (#poke telnet_event_t, type) p eventDont
    (#poke telnet_event_t, neg.telopt) p opt

  poke p (Subnegotiation opt (buffer, size)) = do
    (#poke telnet_event_t, type) p eventSubnegotiation
    (#poke telnet_event_t, sub.telopt) p opt
    (#poke telnet_event_t, sub.buffer) p buffer
    (#poke telnet_event_t, sub.size) p size

  poke p (Zmp (argv, argc)) = do
    (#poke telnet_event_t, type) p eventZmp
    (#poke telnet_event_t, zmp.argv) p argv
    (#poke telnet_event_t, zmp.argc) p argc

  poke p (TerminalType cmd name) = do
    (#poke telnet_event_t, type) p eventTType
    (#poke telnet_event_t, ttype.cmd) p cmd
    (#poke telnet_event_t, ttype.name) p name

  poke p (Compress state) = do
    (#poke telnet_event_t, type) p eventCompress
    (#poke telnet_event_t, compress.state) p state

  poke p (Environ cmd (values, size)) = do
    (#poke telnet_event_t, type) p eventEnviron
    (#poke telnet_event_t, environ.cmd) p cmd
    (#poke telnet_event_t, environ.values) p values
    (#poke telnet_event_t, environ.size) p size

  poke p (Mssp (values, size)) = do
    (#poke telnet_event_t, type) p eventMssp
    (#poke telnet_event_t, mssp.values) p values
    (#poke telnet_event_t, mssp.size) p size

-- | Constants from @telnet_event_type_t@.
newtype TelnetEventTypeT = TelnetEventTypeT { unTelnetEventTypeT :: CInt }
  deriving (Eq, Show, Storable)
#{enum TelnetEventTypeT, TelnetEventTypeT
 , eventData = TELNET_EV_DATA
 , eventSend = TELNET_EV_SEND
 , eventIac = TELNET_EV_IAC
 , eventWill = TELNET_EV_WILL
 , eventWont = TELNET_EV_WONT
 , eventDo = TELNET_EV_DO
 , eventDont = TELNET_EV_DONT
 , eventSubnegotiation = TELNET_EV_SUBNEGOTIATION
 , eventCompress = TELNET_EV_COMPRESS
 , eventZmp = TELNET_EV_ZMP
 , eventTType = TELNET_EV_TTYPE
 , eventEnviron = TELNET_EV_ENVIRON
 , eventMssp = TELNET_EV_MSSP
 , eventWarning = TELNET_EV_WARNING
 , eventError = TELNET_EV_ERROR
 }

-- | Data in 'Warning' and 'Error' events, modeled after @struct
-- error_t@ inside @telnet_event_t@.
data ErrorT = ErrorT
  { _file :: CString
  , _func :: CString
  , _msg :: CString
  , _line :: CInt
  , _errcode :: TelnetErrorT
  }

-- | Constants from @telnet_error_t@.
newtype TelnetErrorT = TelnetErrorT { unTelnetErrorT :: CInt }
  deriving (Eq, Show, Storable)
#{enum TelnetErrorT, TelnetErrorT
 , errOK = TELNET_EOK
 , errBadVal = TELNET_EBADVAL
 , errNoMem = TELNET_ENOMEM
 , errOverflow = TELNET_EOVERFLOW
 , errProtocol = TELNET_EPROTOCOL
 , errCompress = TELNET_ECOMPRESS
 }

-- | Constants for @TERMINAL-TYPE@ commands.
newtype TCmd = TCmd { unTCmd :: CUChar } deriving (Eq, Show, Storable)
#{enum TCmd, TCmd
 , tCmdIs = TELNET_TTYPE_IS
 , tCmdSend = TELNET_TTYPE_SEND
 }

-- | Constants for @ENVIRON@/@NEW-ENVIRON@ commands.
newtype ECmd = ECmd { unECmd :: CUChar } deriving (Eq, Show, Storable)
#{enum ECmd, ECmd
 , eCmdIs = TELNET_ENVIRON_IS
 , eCmdSend = TELNET_ENVIRON_SEND
 , eCmdInfo = TELNET_ENVIRON_INFO
 }

-- | Constants for @ENVIRON@/@NEW-ENVIRON@ variables.
newtype EVar = EVar { unEvar :: CUChar } deriving (Eq, Show, Storable)
#{enum EVar, EVar
 , eVar = TELNET_ENVIRON_VAR
 , eValue = TELNET_ENVIRON_VALUE
 , eUserVar = TELNET_ENVIRON_USERVAR
 }

-- | Constants for MSSP.
newtype MsspVar = MsspVar { unMsspVar :: CUChar } deriving (Eq, Show, Storable)
#{enum MsspVar, MsspVar
 , msspVar = TELNET_MSSP_VAR
 , msspVal = TELNET_MSSP_VAL
 }

-- | @ENVIRONMENT@\/@NEW-ENVIRONMENT@\/@MSSP@ messages, wrapping
-- @telnet_environ_t@.
data TelnetEnvironT = TelnetEnvironT
  { _type :: EVar -- ^ @unsigned char type@
  , _var :: CString -- ^ @char *var@
  , _value :: CString -- ^ @char *value@
  }

instance Storable TelnetEnvironT where
  sizeOf _ = (#size struct telnet_environ_t)
  alignment _ = (#alignment struct telnet_environ_t)

  peek p = do
    type_ <- (#peek struct telnet_environ_t, type) p
    var <- (#peek struct telnet_environ_t, var) p
    value <- (#peek struct telnet_environ_t, value) p

    pure $ TelnetEnvironT type_ var value

  poke p TelnetEnvironT{..} = do
    (#poke struct telnet_environ_t, type) p _type
    (#poke struct telnet_environ_t, var) p _var
    (#poke struct telnet_environ_t, value) p _value