{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

{-|
Module      : Reflex.LibTelnet
Description : Reflex wrapper around libtelnet
Copyright   : (c) 2019 Jack Kelly
License     : GPL-3.0-or-later
Maintainer  : jack@jackkelly.name
Stability   : experimental
Portability : non-portable

How to run a libtelnet state tracker off Reflex 'Event's:

1. Construct a 'TelnetConfig' by using 'def' to get an empty config,
   and then fill it out using record updates or lenses.

2. Start a state tracker by calling 'telnet' on your config.

3. Wire the events from the returned 'TelnetEvents' into the rest of
   your application.
-}

module Reflex.LibTelnet
  ( telnet

    -- * Input Events
  , TelnetConfig(..)

    -- * Output Events
  , TelnetEvents(..)

    -- * Lenses
    -- ** TelnetConfig
  , cOptions
  , cFlags
  , cRecv
  , cSend
  , cIac
  , cNegotiate
  , cSubnegotiation
  , cBeginCompress2
  , cNewEnvironSend
  , cNewEnviron
  , cTTypeSend
  , cTTypeIs
  , cSendZmp
  , cSendMssp

    -- ** TelnetEvents
  , eReceived
  , eSend
  , eWarning
  , eError
  , eIac
  , eWill
  , eWont
  , eDo
  , eDont
  , eSubnegotiation
  , eZmp
  , eTerminalTypeSend
  , eTerminalTypeIs
  , eCompress
  , eEnvironSend
  , eEnviron
  , eMssp
  , eException
  ) where

import           Control.Exception (catch)
import           Control.Lens (Lens', (^.), makeLenses)
import           Control.Monad.IO.Class (MonadIO(..))
import           Data.ByteString (ByteString)
import           Data.Default (Default(..))
import qualified Data.Dependent.Map as DMap
import           Data.Dependent.Sum ((==>))
import           Data.Functor ((<&>))
import           Data.GADT.Compare.TH (deriveGCompare, deriveGEq)
import           Data.GADT.Show.TH (deriveGShow)
import           Network.Telnet.LibTelnet (Telnet)
import qualified Network.Telnet.LibTelnet as Telnet
import           Network.Telnet.LibTelnet.Iac (Iac)
import           Network.Telnet.LibTelnet.Options (Option)
import           Reflex

-- | A @'TelnetConfig' t@ contains all the input events for a telnet
-- state tracker. When passed to 'telnet', the network will call each
-- libtelnet function when its corresponding event fires. An "input
-- event" describes all events the state tracker listens to; it
-- doesn't care whether the events are coming from "above" or "below"
-- itself in the application stack. Data arriving on the socket
-- ('_cRecv') is an "input event" from "below"; data pasing through
-- libtelnet on its way out to the socket ('_cSend') is also an "input
-- event", but from "above".
--
-- You will almost certainly want to:
--
-- 1. use 'def' to get an empty 'TelnetConfig';
-- 2. replace the '_cRecv' event with incoming socket data; and
-- 3. replace the '_cSend' event with outgoing data from your application.
--
-- @since 0.1.0.0
data TelnetConfig t = TelnetConfig
  { _cOptions :: [Telnet.OptionSpec]
    -- ^ Passed to 'Telnet.telnetInit'
  , _cFlags :: [Telnet.Flag]
    -- ^ Passed to 'Telnet.telnetInit'
  , _cRecv :: Event t ByteString
    -- ^ 'Telnet.telnetRecv' - "I just received this data, please decode it"
  , _cSend :: Event t ByteString
    -- ^ 'Telnet.telnetSend' - "I want to send this data out, please encode it"
  , _cIac :: Event t Iac
    -- ^ 'Telnet.telnetIac'
  , _cNegotiate :: Event t (Iac, Option)
    -- ^ 'Telnet.telnetNegotiate'
  , _cSubnegotiation :: Event t (Option, ByteString)
    -- ^ 'Telnet.telnetSubnegotiation'
  , _cBeginCompress2 :: Event t ()
    -- ^ 'Telnet.telnetBeginCompress2'
  , _cNewEnvironSend :: Event t [(Telnet.Var, ByteString)]
    -- ^ 'Telnet.telnetNewEnvironSend'
  , _cNewEnviron :: Event t ( Telnet.IsInfo
                            , [(Telnet.Var, ByteString, ByteString)]
                            )
    -- ^ 'Telnet.telnetNewEnviron'
  , _cTTypeSend :: Event t ()
    -- ^ 'Telnet.telnetTTypeSend'
  , _cTTypeIs :: Event t ByteString
    -- ^ 'Telnet.telnetTTypeIs'
  , _cSendZmp :: Event t [ByteString]
    -- ^ 'Telnet.telnetSendZmp'
  , _cSendMssp :: Event t [(ByteString, [ByteString])]
    -- ^ 'Telnet.telnetSendMssp'
  }

$(makeLenses ''TelnetConfig)

-- | No options set and all events are 'never'.
--
-- @since 0.1.0.0
instance Reflex t => Default (TelnetConfig t) where
  def = TelnetConfig
    { _cOptions = []
    , _cFlags = []
    , _cRecv = never
    , _cSend = never
    , _cIac = never
    , _cNegotiate = never
    , _cSubnegotiation = never
    , _cBeginCompress2 = never
    , _cNewEnvironSend = never
    , _cNewEnviron = never
    , _cTTypeSend = never
    , _cTTypeIs = never
    , _cSendZmp = never
    , _cSendMssp = never
    }

-- | The libtelnet 'Telnet.Event' type is fanned out into a set of
-- individual "output events". An "output event" describes all events
-- that should be listened to, regardless of whether they are going
-- "up" or "down" the application stack: parsed data ('_eReceived') is
-- an "output event" that should be listened to by the layer "above";
-- encoded data that should go to a socket ('_eSend') is also an
-- "output event", but listened to by the layer below.
--
-- @since 0.1.0.0
data TelnetEvents t = TelnetEvents
  { _eReceived :: Event t ByteString
    -- ^ 'Telnet.Received' - "Here is some decoded data, please send
    -- it up to the application"
  , _eSend :: Event t ByteString
    -- ^ 'Telnet.Send' - "Here is some encoded data, please send it
    -- out on the socket"
  , _eWarning :: Event t Telnet.Err
    -- ^ 'Telnet.Warning'
  , _eError :: Event t Telnet.Err
    -- ^ 'Telnet.Error'
  , _eIac :: Event t Iac
    -- ^ 'Telnet.Iac'
  , _eWill :: Event t Option
    -- ^ 'Telnet.Will'
  , _eWont :: Event t Option
    -- ^ 'Telnet.Wont'
  , _eDo :: Event t Option
    -- ^ 'Telnet.Do'
  , _eDont :: Event t Option
    -- ^ 'Telnet.Dont'
  , _eSubnegotiation :: Event t (Option, ByteString)
    -- ^ 'Telnet.Subnegotiation'
  , _eZmp :: Event t [ByteString]
    -- ^ 'Telnet.Zmp'
  , _eTerminalTypeSend :: Event t ()
    -- ^ 'Telnet.TerminalTypeSend'
  , _eTerminalTypeIs :: Event t ByteString
    -- ^ 'Telnet.TerminalTypeIs'
  , _eCompress :: Event t Bool
    -- ^ 'Telnet.Compress'
  , _eEnvironSend :: Event t [(Telnet.Var, ByteString)]
    -- ^ 'Telnet.EnvironSend'
  , _eEnviron :: Event t (Telnet.IsInfo, [(Telnet.Var, ByteString, ByteString)])
    -- ^ 'Telnet.Environ'
  , _eMssp :: Event t [(ByteString, [ByteString])]
    -- ^ 'Telnet.Mssp'
  , _eException :: Event t Telnet.TelnetException
    -- ^ Exceptions thrown by the binding are caught and emitted
    -- here. Protocol errors and warnings are emitted on the
    -- '_eWarning' and '_eError' events.
  }

$(makeLenses ''TelnetEvents)

data EventKey a where
  Received :: EventKey ByteString
  Send :: EventKey ByteString
  Warning :: EventKey Telnet.Err
  Error :: EventKey Telnet.Err
  Iac :: EventKey Iac
  Will :: EventKey Option
  Wont :: EventKey Option
  Do :: EventKey Option
  Dont :: EventKey Option
  Subnegotiation :: EventKey (Option, ByteString)
  Zmp :: EventKey [ByteString]
  TerminalTypeSend :: EventKey ()
  TerminalTypeIs :: EventKey ByteString
  Compress :: EventKey Bool
  EnvironSend :: EventKey [(Telnet.Var, ByteString)]
  Environ :: EventKey (Telnet.IsInfo, [(Telnet.Var, ByteString, ByteString)])
  Mssp :: EventKey [(ByteString, [ByteString])]

$(deriveGEq ''EventKey)
$(deriveGCompare ''EventKey)
$(deriveGShow ''EventKey)

-- | Process telnet streams using
-- <https://github.com/seanmiddleditch/libtelnet libtelnet>. The
-- easiest way to get a @'TelnetConfig' t@ is through its 'Default'
-- instance; see 'TelnetConfig' for details.
--
-- @since 0.1.0.0
telnet
  :: forall t m .
     ( MonadIO m, MonadIO (Performable m)
     , PerformEvent t m
     , TriggerEvent t m
     )
  => TelnetConfig t
  -> m (TelnetEvents t)
telnet config = do
  (telnetE, fireTelnetE) <- newTriggerEvent
  (telnetExcE, fireTelnetExcE) <- newTriggerEvent
  t <- liftIO $ Telnet.telnetInit
    (config ^. cOptions)
    (config ^. cFlags)
    (const fireTelnetE)

  let
    perform
      :: (Telnet -> a -> IO ())
      -> Lens' (TelnetConfig t) (Event t a)
      -> m ()
    perform f l = performEvent_ $ action <$> config ^. l where
      action x = liftIO $ f t x `catch` \(ex :: Telnet.TelnetException) ->
        fireTelnetExcE ex

  perform Telnet.telnetRecv cRecv
  perform Telnet.telnetSend cSend
  perform Telnet.telnetIac cIac
  perform (uncurry . Telnet.telnetNegotiate) cNegotiate
  perform (uncurry . Telnet.telnetSubnegotiation) cSubnegotiation
  perform (const . Telnet.telnetBeginCompress2) cBeginCompress2
  perform Telnet.telnetNewEnvironSend cNewEnvironSend
  perform (uncurry . Telnet.telnetNewEnviron) cNewEnviron
  perform (const . Telnet.telnetTTypeSend) cTTypeSend
  perform Telnet.telnetTTypeIs cTTypeIs
  perform Telnet.telnetSendZmp cSendZmp
  perform Telnet.telnetSendMssp cSendMssp

  let
    selector :: EventSelector t EventKey
    selector = fan $ telnetE <&> DMap.fromList . pure . \case
      Telnet.Received b -> Received ==> b
      Telnet.Send b -> Send ==> b
      Telnet.Warning e -> Warning ==> e
      Telnet.Error e -> Error ==> e
      Telnet.Iac i -> Iac ==> i
      Telnet.Will o -> Will ==> o
      Telnet.Wont o -> Wont ==> o
      Telnet.Do o -> Do ==> o
      Telnet.Dont o -> Dont ==> o
      Telnet.Subnegotiation o b -> Subnegotiation ==> (o, b)
      Telnet.Zmp bs -> Zmp ==> bs
      Telnet.TerminalTypeSend -> TerminalTypeSend ==> ()
      Telnet.TerminalTypeIs term -> TerminalTypeIs ==> term
      Telnet.Compress c -> Compress ==> c
      Telnet.EnvironSend envs -> EnvironSend ==> envs
      Telnet.Environ isInfo envs -> Environ ==> (isInfo, envs)
      Telnet.Mssp msg -> Mssp ==> msg

  pure $ TelnetEvents
    { _eReceived = selector `select` Received
    , _eSend = selector `select` Send
    , _eWarning = selector `select` Warning
    , _eError = selector `select` Error
    , _eIac = selector `select` Iac
    , _eWill  = selector `select` Will
    , _eWont  = selector `select` Wont
    , _eDo  = selector `select` Do
    , _eDont  = selector `select` Dont
    , _eSubnegotiation  = selector `select` Subnegotiation
    , _eZmp  = selector `select` Zmp
    , _eTerminalTypeSend  = selector `select` TerminalTypeSend
    , _eTerminalTypeIs  = selector `select` TerminalTypeIs
    , _eCompress  = selector `select` Compress
    , _eEnvironSend  = selector `select` EnvironSend
    , _eEnviron  = selector `select` Environ
    , _eMssp  = selector `select` Mssp
    , _eException = telnetExcE
    }