reflex-libtelnet-0.1.0.0: src/Reflex/LibTelnet.hs
{-# 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
}