{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MultiWayIf           #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-|
Module      : Network.Telnet.LibTelnet
Description : Bindings to C libtelnet
Copyright   : (c) 2017-2019 Jack Kelly
License     : GPL-3.0-or-later
Maintainer  : jack@jackkelly.name
Stability   : experimental
Portability : non-portable

Getting Started:

1. Skim
<https://github.com/seanmiddleditch/libtelnet the libtelnet documentation>,
as these bindings follow the C library's conventions quite closely.

2. Write an event-handling function, of type 'EventHandler'.

3. When you accept a new connection, create a 'Telnet' state
tracker for it using 'telnetInit'. Options and flags are defined in
the same way as the C library; option constants are exported from
"Network.Telnet.LibTelnet.Options".

4. When you receive data (probably on a socket), tell 'Telnet'
about it using 'telnetRecv'.

5. To send data, negotiate options, &c., use 'telnetSend',
'telnetIac', &c.

6. IAC (Interpret-As-Command) codes are exported from
"Network.Telnet.LibTelnet.Iac".
-}

module Network.Telnet.LibTelnet
  ( telnetInit
  , OptionSpec(..)
  , T.Flag
  , T.flagProxy

  -- * Telnet pointers
  , Telnet
  , TelnetPtr
  , HasTelnetPtr(..)

  -- * Event handling
  , EventHandler
  , Event(..)
  , Err(..)
  , IsInfo(..)
  , Var(..)

  -- * Simple operations
  , telnetRecv
  , telnetSend

  -- * Generic telnet option negotiation
  , telnetIac
  , telnetNegotiate
  , telnetSubnegotiation

  -- * Compression <http://www.gammon.com.au/mccp/protocol.html (MCCP2)>
  , telnetBeginCompress2

  -- * @NEW-ENVIRON@ functions <http://www.faqs.org/rfcs/rfc1572.html (RFC 1572)>
  , telnetNewEnvironSend
  , telnetNewEnviron

  -- * @TERMINAL-TYPE@ functions <http://www.faqs.org/rfcs/rfc1091.html (RFC 1091)>
  , telnetTTypeSend
  , telnetTTypeIs

  -- * ZMP <http://discworld.starturtle.net/external/protocols/zmp.html (Zenith Mud Protocol)>
  , telnetSendZmp

  -- * MSSP <http://tintin.sourceforge.net/mssp/ (Mud Server Status Protocol)>
  , telnetSendMssp

  -- * Exceptions
  , T.TelnetException(..)
  ) where

import qualified Network.Telnet.LibTelnet.Ffi as F
import qualified Network.Telnet.LibTelnet.Iac as I
import           Network.Telnet.LibTelnet.Options (Option(..), optMSSP)
import qualified Network.Telnet.LibTelnet.Types as T

import           Control.Exception (throw, throwIO)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import           Data.Foldable (traverse_)
import           Data.Function (on)
import           Data.List (groupBy)
import           Data.Typeable (Typeable)
import           Foreign (ForeignPtr, Ptr, peek, peekArray, withForeignPtr)
import           Foreign.C.String (castCUCharToChar)
import           GHC.Generics (Generic)

-- | Create a @libtelnet@ state tracker.
telnetInit :: [OptionSpec] -> [T.Flag] -> EventHandler -> IO Telnet
telnetInit :: [OptionSpec] -> [Flag] -> EventHandler -> IO Telnet
telnetInit options :: [OptionSpec]
options flags :: [Flag]
flags handler :: EventHandler
handler =
    [TelnetTeloptT] -> TelnetEventHandlerT -> [Flag] -> IO Telnet
F.telnetInit [TelnetTeloptT]
options' (EventHandler -> TelnetEventHandlerT
convertEventHandler EventHandler
handler) [Flag]
flags
  where
    options' :: [TelnetTeloptT]
options' = (OptionSpec -> TelnetTeloptT) -> [OptionSpec] -> [TelnetTeloptT]
forall a b. (a -> b) -> [a] -> [b]
map OptionSpec -> TelnetTeloptT
f [OptionSpec]
options
    f :: OptionSpec -> TelnetTeloptT
f (OptionSpec opt :: Option
opt us :: Bool
us him :: Bool
him) =
      let us' :: Iac
us' = if Bool
us then Iac
I.iacWill else Iac
I.iacWont
          him' :: Iac
him' = if Bool
him then Iac
I.iacDo else Iac
I.iacDont
      in CShort -> Iac -> Iac -> TelnetTeloptT
T.TelnetTeloptT (CUChar -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUChar -> CShort) -> CUChar -> CShort
forall a b. (a -> b) -> a -> b
$ Option -> CUChar
unOption Option
opt) Iac
us' Iac
him'

-- | Configures which options you want to support. The triple's
-- elements are: option code, support on our end (corresponds to
-- @WILL/WONT@), support on their end (corresponds to @DO/DONT@).
data OptionSpec = OptionSpec
  { OptionSpec -> Option
_code :: Option -- ^ Option code
  , OptionSpec -> Bool
_us :: Bool -- ^ Supported on our end? (@WILL@/@WONT@)
  , OptionSpec -> Bool
_him :: Bool -- ^ Can other end use it with us? (@DO@/@DONT@)
  } deriving (OptionSpec -> OptionSpec -> Bool
(OptionSpec -> OptionSpec -> Bool)
-> (OptionSpec -> OptionSpec -> Bool) -> Eq OptionSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionSpec -> OptionSpec -> Bool
$c/= :: OptionSpec -> OptionSpec -> Bool
== :: OptionSpec -> OptionSpec -> Bool
$c== :: OptionSpec -> OptionSpec -> Bool
Eq, (forall x. OptionSpec -> Rep OptionSpec x)
-> (forall x. Rep OptionSpec x -> OptionSpec) -> Generic OptionSpec
forall x. Rep OptionSpec x -> OptionSpec
forall x. OptionSpec -> Rep OptionSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OptionSpec x -> OptionSpec
$cfrom :: forall x. OptionSpec -> Rep OptionSpec x
Generic, Int -> OptionSpec -> ShowS
[OptionSpec] -> ShowS
OptionSpec -> String
(Int -> OptionSpec -> ShowS)
-> (OptionSpec -> String)
-> ([OptionSpec] -> ShowS)
-> Show OptionSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionSpec] -> ShowS
$cshowList :: [OptionSpec] -> ShowS
show :: OptionSpec -> String
$cshow :: OptionSpec -> String
showsPrec :: Int -> OptionSpec -> ShowS
$cshowsPrec :: Int -> OptionSpec -> ShowS
Show, Typeable)

-- | Garbage-collected pointer to the @libtelnet@ state tracker. Your
-- program should hang on to this.
type Telnet = ForeignPtr T.TelnetT

-- | Raw pointer to the @libtelnet@ state tracker. This is passed to
-- the event handlers and you shouldn't see it elsewhere.
type TelnetPtr = Ptr T.TelnetT

-- | The pointer you get back from 'telnetInit' is a 'ForeignPtr'
-- because it carries around its finalizers, but the pointer that gets
-- passed into your 'EventHandler' is a bare 'Ptr' because it's being
-- passed in from C. This class lets us generalise across both types.
class HasTelnetPtr t where
  withTelnetPtr :: t -> (TelnetPtr -> IO a) -> IO a

-- | Unwrap with 'withForeignPtr'.
instance HasTelnetPtr Telnet where
  withTelnetPtr :: Telnet -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr = Telnet -> (TelnetPtr -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr

-- | No unwrapping needed.
instance HasTelnetPtr TelnetPtr where
  withTelnetPtr :: TelnetPtr -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t :: TelnetPtr
t f :: TelnetPtr -> IO a
f = TelnetPtr -> IO a
f TelnetPtr
t

-- | Type of the event handler callback.
type EventHandler = TelnetPtr -> Event -> IO ()

-- | Structure provided to the event handler.
data Event
  = Received ByteString
    -- ^ Data received; you should pass it to the application.
  | Send ByteString
    -- ^ Data you need to send out to the socket.
  | Warning Err
    -- ^ Something has gone wrong inside of libtelnet but
    -- recovery is (likely) possible.
  | Error Err
    -- ^ Something has gone wrong. The application should
    -- immediately close the connection.
  | Iac I.Iac -- ^ Telnet interpret-as-command.
  | Will Option -- ^ Other end offers an option.
  | Wont Option -- ^ Other end cannot support option.
  | Do Option -- ^ Other end asked you to support option.
  | Dont Option -- ^ Other end asked you to stop using option.
  | Subnegotiation Option ByteString
    -- ^ Subnegotiation received for some option.
  | Zmp [ByteString]
    -- ^ <http://discworld.starturtle.net/external/protocols/zmp.html Zenith Mud Protocol>
    -- message
  | TerminalTypeSend
    -- ^ @TERMINAL-TYPE SEND@ message
    -- <http://www.faqs.org/rfcs/rfc1091.html (RFC 1091)>.
    -- The server wants to know about your terminal-type.
  | TerminalTypeIs ByteString
    -- ^ @TERMINAL-TYPE IS@ message
    -- <http://www.faqs.org/rfcs/rfc1091.html (RFC 1091)>.
    -- The client has told us a terminal-type.
  | Compress Bool
    -- ^ Would the client like
    -- <http://www.gammon.com.au/mccp/protocol.html MCCP Version 2>?
  | EnvironSend [(Var, ByteString)]
    -- ^ Request to send the following environment variables, per
    -- <http://www.faqs.org/rfcs/rfc1408.html (RFC 1408)> and
    -- <http://www.faqs.org/rfcs/rfc1572.html (RFC 1572)>.
  | Environ IsInfo [(Var, ByteString, ByteString)]
    -- ^ @ENVIRON@/@NEW-ENVIRON@ options, per
    -- <http://www.faqs.org/rfcs/rfc1408.html (RFC 1408)> and
    -- <http://www.faqs.org/rfcs/rfc1572.html (RFC 1572)>.
    -- Keys come before values in the tuples.
  | Mssp [(ByteString, [ByteString])]
    -- ^ <http://tintin.sourceforge.net/mssp/ Mud Server Status Protocol>
    -- List is @(key, values)@.
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Typeable)

-- | Error message from @libtelnet@.
data Err = Err
  { Err -> ByteString
_file :: ByteString
  , Err -> ByteString
_func :: ByteString
  , Err -> ByteString
_msg :: ByteString
  , Err -> Int
_line :: Int
  , Err -> TelnetErrorT
_errcode :: T.TelnetErrorT
  }
  deriving (Err -> Err -> Bool
(Err -> Err -> Bool) -> (Err -> Err -> Bool) -> Eq Err
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err -> Err -> Bool
$c/= :: Err -> Err -> Bool
== :: Err -> Err -> Bool
$c== :: Err -> Err -> Bool
Eq, (forall x. Err -> Rep Err x)
-> (forall x. Rep Err x -> Err) -> Generic Err
forall x. Rep Err x -> Err
forall x. Err -> Rep Err x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Err x -> Err
$cfrom :: forall x. Err -> Rep Err x
Generic, Int -> Err -> ShowS
[Err] -> ShowS
Err -> String
(Int -> Err -> ShowS)
-> (Err -> String) -> ([Err] -> ShowS) -> Show Err
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err] -> ShowS
$cshowList :: [Err] -> ShowS
show :: Err -> String
$cshow :: Err -> String
showsPrec :: Int -> Err -> ShowS
$cshowsPrec :: Int -> Err -> ShowS
Show, Typeable)

-- | Were the 'Environ' fields sent as part of a @NEW-ENVIRON IS@
-- message, or part of a @NEW-ENVIRON INFO@ message?
data IsInfo = Is | Info deriving (IsInfo -> IsInfo -> Bool
(IsInfo -> IsInfo -> Bool)
-> (IsInfo -> IsInfo -> Bool) -> Eq IsInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsInfo -> IsInfo -> Bool
$c/= :: IsInfo -> IsInfo -> Bool
== :: IsInfo -> IsInfo -> Bool
$c== :: IsInfo -> IsInfo -> Bool
Eq, Int -> IsInfo -> ShowS
[IsInfo] -> ShowS
IsInfo -> String
(Int -> IsInfo -> ShowS)
-> (IsInfo -> String) -> ([IsInfo] -> ShowS) -> Show IsInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsInfo] -> ShowS
$cshowList :: [IsInfo] -> ShowS
show :: IsInfo -> String
$cshow :: IsInfo -> String
showsPrec :: Int -> IsInfo -> ShowS
$cshowsPrec :: Int -> IsInfo -> ShowS
Show)

-- | In an 'Environ' message, are the vars being sent as @VAR@s or @USERVAR@s?
data Var = Var | UserVar deriving (Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq, Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> String
$cshow :: Var -> String
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show)

-- | Tell the state tracker about received data.
telnetRecv :: HasTelnetPtr t => t -> ByteString -> IO ()
telnetRecv :: t -> ByteString -> IO ()
telnetRecv t :: t
t bs :: ByteString
bs = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> ByteString -> IO ()
F.telnetRecv TelnetPtr
telnetP ByteString
bs

-- | Send non-command data.
telnetSend :: HasTelnetPtr t => t -> ByteString -> IO ()
telnetSend :: t -> ByteString -> IO ()
telnetSend t :: t
t bs :: ByteString
bs = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> ByteString -> IO ()
F.telnetSend TelnetPtr
telnetP ByteString
bs

-- | Send a telnet command.
telnetIac :: HasTelnetPtr t => t -> I.Iac -> IO ()
telnetIac :: t -> Iac -> IO ()
telnetIac t :: t
t c :: Iac
c = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> Iac -> IO ()
F.cTelnetIac TelnetPtr
telnetP Iac
c

-- | Send a negotiation command.
telnetNegotiate :: HasTelnetPtr t => t -> I.Iac -> Option -> IO ()
telnetNegotiate :: t -> Iac -> Option -> IO ()
telnetNegotiate t :: t
t cmd :: Iac
cmd opt :: Option
opt = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> Iac -> Option -> IO ()
F.cTelnetNegotiate TelnetPtr
telnetP Iac
cmd Option
opt

-- | Send a subnegotiation.
telnetSubnegotiation :: HasTelnetPtr t => t -> Option -> ByteString -> IO ()
telnetSubnegotiation :: t -> Option -> ByteString -> IO ()
telnetSubnegotiation t :: t
t opt :: Option
opt bs :: ByteString
bs = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> Option -> ByteString -> IO ()
F.telnetSubnegotiation TelnetPtr
telnetP Option
opt ByteString
bs

-- | Begin sending compressed data, using the @COMPRESS2@ option. The
-- server should call this command in response to a @'Compress' True@
-- event.
telnetBeginCompress2 :: HasTelnetPtr t => t -> IO ()
telnetBeginCompress2 :: t -> IO ()
telnetBeginCompress2 t :: t
t = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> IO ()
F.cTelnetBeginCompress2 TelnetPtr
telnetP

-- | Ask the client to send us these environment variables.
telnetNewEnvironSend :: HasTelnetPtr t => t -> [(Var, ByteString)] -> IO ()
telnetNewEnvironSend :: t -> [(Var, ByteString)] -> IO ()
telnetNewEnvironSend t :: t
t vars :: [(Var, ByteString)]
vars = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> do
    let sendVar :: (Var, ByteString) -> IO ()
sendVar (var :: Var
var, str :: ByteString
str) = ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B8.useAsCString ByteString
str (EVar -> CString -> IO ()
sendVal (EVar -> CString -> IO ()) -> EVar -> CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Var -> EVar
varToEvar Var
var)
        sendVal :: EVar -> CString -> IO ()
sendVal = TelnetPtr -> EVar -> CString -> IO ()
F.cTelnetNewEnvironValue TelnetPtr
telnetP

    TelnetPtr -> ECmd -> IO ()
F.cTelnetBeginNewEnviron TelnetPtr
telnetP ECmd
T.eCmdSend
    ((Var, ByteString) -> IO ()) -> [(Var, ByteString)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Var, ByteString) -> IO ()
sendVar [(Var, ByteString)]
vars
    TelnetPtr -> Iac -> IO ()
F.cTelnetIac TelnetPtr
telnetP Iac
I.iacSE

-- | Tell the server about our environment variables.
telnetNewEnviron
  :: HasTelnetPtr t => t -> IsInfo -> [(Var, ByteString, ByteString)] -> IO ()
telnetNewEnviron :: t -> IsInfo -> [(Var, ByteString, ByteString)] -> IO ()
telnetNewEnviron t :: t
t isInfo :: IsInfo
isInfo vars :: [(Var, ByteString, ByteString)]
vars = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> do
    let isInfo' :: ECmd
isInfo' = case IsInfo
isInfo of
          Is -> ECmd
T.eCmdIs
          Info -> ECmd
T.eCmdInfo

        sendVar :: (Var, ByteString, ByteString) -> IO ()
sendVar (var :: Var
var, name :: ByteString
name, value :: ByteString
value) =
          ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B8.useAsCString ByteString
name (EVar -> CString -> IO ()
sendVal (EVar -> CString -> IO ()) -> EVar -> CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Var -> EVar
varToEvar Var
var) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
          ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B8.useAsCString ByteString
value (EVar -> CString -> IO ()
sendVal EVar
T.eValue)

        sendVal :: EVar -> CString -> IO ()
sendVal = TelnetPtr -> EVar -> CString -> IO ()
F.cTelnetNewEnvironValue TelnetPtr
telnetP

    TelnetPtr -> ECmd -> IO ()
F.cTelnetBeginNewEnviron TelnetPtr
telnetP ECmd
isInfo'
    ((Var, ByteString, ByteString) -> IO ())
-> [(Var, ByteString, ByteString)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Var, ByteString, ByteString) -> IO ()
sendVar [(Var, ByteString, ByteString)]
vars
    TelnetPtr -> Iac -> IO ()
F.cTelnetIac TelnetPtr
telnetP Iac
I.iacSE

-- | Ask the client to give us a terminal type.
telnetTTypeSend :: HasTelnetPtr t => t -> IO ()
telnetTTypeSend :: t -> IO ()
telnetTTypeSend t :: t
t = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t TelnetPtr -> IO ()
F.cTelnetTTypeSend

-- | Tell the server a terminal type.
telnetTTypeIs :: HasTelnetPtr t => t -> ByteString -> IO ()
telnetTTypeIs :: t -> ByteString -> IO ()
telnetTTypeIs t :: t
t bs :: ByteString
bs = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B8.useAsCString ByteString
bs (TelnetPtr -> CString -> IO ()
F.cTelnetTTypeIs TelnetPtr
telnetP)

-- | Send a ZMP command.
telnetSendZmp :: HasTelnetPtr t => t -> [ByteString] -> IO ()
telnetSendZmp :: t -> [ByteString] -> IO ()
telnetSendZmp t :: t
t cmd :: [ByteString]
cmd = t -> (TelnetPtr -> IO ()) -> IO ()
forall t a. HasTelnetPtr t => t -> (TelnetPtr -> IO a) -> IO a
withTelnetPtr t
t ((TelnetPtr -> IO ()) -> IO ()) -> (TelnetPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \telnetP :: TelnetPtr
telnetP -> TelnetPtr -> [ByteString] -> IO ()
F.telnetSendZmp TelnetPtr
telnetP [ByteString]
cmd

-- | Send an MSSP status.
telnetSendMssp :: HasTelnetPtr t => t -> [(ByteString, [ByteString])] -> IO ()
telnetSendMssp :: t -> [(ByteString, [ByteString])] -> IO ()
telnetSendMssp t :: t
t stats :: [(ByteString, [ByteString])]
stats = t -> Option -> ByteString -> IO ()
forall t. HasTelnetPtr t => t -> Option -> ByteString -> IO ()
telnetSubnegotiation t
t Option
optMSSP ByteString
stats' where
  stats' :: ByteString
stats' = ((ByteString, [ByteString]) -> ByteString)
-> [(ByteString, [ByteString])] -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, [ByteString]) -> ByteString
forall (t :: * -> *).
Foldable t =>
(ByteString, t ByteString) -> ByteString
pack [(ByteString, [ByteString])]
stats
  pack :: (ByteString, t ByteString) -> ByteString
pack (var :: ByteString
var, vals :: t ByteString
vals) = ByteString
msspVar ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
var ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString) -> t ByteString -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString
msspVal ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) t ByteString
vals

  msspVar :: ByteString
msspVar = Char -> ByteString
B8.singleton (Char -> ByteString) -> (MsspVar -> Char) -> MsspVar -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Char
castCUCharToChar (CUChar -> Char) -> (MsspVar -> CUChar) -> MsspVar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsspVar -> CUChar
T.unMsspVar (MsspVar -> ByteString) -> MsspVar -> ByteString
forall a b. (a -> b) -> a -> b
$ MsspVar
T.msspVar
  msspVal :: ByteString
msspVal = Char -> ByteString
B8.singleton (Char -> ByteString) -> (MsspVar -> Char) -> MsspVar -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Char
castCUCharToChar (CUChar -> Char) -> (MsspVar -> CUChar) -> MsspVar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsspVar -> CUChar
T.unMsspVar (MsspVar -> ByteString) -> MsspVar -> ByteString
forall a b. (a -> b) -> a -> b
$ MsspVar
T.msspVal

-- | Convert the event structure from the FFI into something nicer.
convertEventT :: T.EventT -> IO Event
convertEventT :: EventT -> IO Event
convertEventT (T.Data (str :: CString
str, len :: CSize
len)) =
  ByteString -> Event
Received (ByteString -> Event) -> IO ByteString -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B8.packCStringLen (CString
str, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

convertEventT (T.Send (str :: CString
str, len :: CSize
len)) =
  ByteString -> Event
Send (ByteString -> Event) -> IO ByteString -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B8.packCStringLen (CString
str, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

convertEventT (T.Warning e :: ErrorT
e) = Err -> Event
Warning (Err -> Event) -> IO Err -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorT -> IO Err
packErrorT ErrorT
e

convertEventT (T.Error e :: ErrorT
e) = Err -> Event
Error (Err -> Event) -> IO Err -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorT -> IO Err
packErrorT ErrorT
e

convertEventT (T.Command cmd :: Iac
cmd) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ Iac -> Event
Iac Iac
cmd

convertEventT (T.Will opt :: Option
opt) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ Option -> Event
Will Option
opt

convertEventT (T.Wont opt :: Option
opt) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ Option -> Event
Wont Option
opt

convertEventT (T.Do opt :: Option
opt) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ Option -> Event
Do Option
opt

convertEventT (T.Dont opt :: Option
opt) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ Option -> Event
Dont Option
opt

convertEventT (T.Subnegotiation opt :: Option
opt (str :: CString
str, len :: CSize
len)) =
  Option -> ByteString -> Event
Subnegotiation Option
opt (ByteString -> Event) -> IO ByteString -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B8.packCStringLen (CString
str, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

convertEventT (T.Zmp (argv :: Ptr CString
argv, argc :: CSize
argc)) =
  [ByteString] -> Event
Zmp ([ByteString] -> Event) -> IO [ByteString] -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CString -> IO ByteString) -> [CString] -> IO [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CString -> IO ByteString
B8.packCString ([CString] -> IO [ByteString]) -> IO [CString] -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
argc) Ptr CString
argv)

convertEventT (T.TerminalType cmd :: TCmd
cmd name :: CString
name)
  | TCmd
cmd TCmd -> TCmd -> Bool
forall a. Eq a => a -> a -> Bool
== TCmd
T.tCmdIs = ByteString -> Event
TerminalTypeIs (ByteString -> Event) -> IO ByteString -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
B8.packCString CString
name
  | TCmd
cmd TCmd -> TCmd -> Bool
forall a. Eq a => a -> a -> Bool
== TCmd
T.tCmdSend = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
TerminalTypeSend
  | Bool
otherwise = TelnetException -> IO Event
forall e a. Exception e => e -> IO a
throwIO (TelnetException -> IO Event) -> TelnetException -> IO Event
forall a b. (a -> b) -> a -> b
$ TCmd -> TelnetException
T.UnexpectedTerminalTypeCmd TCmd
cmd

convertEventT (T.Compress ok :: CUChar
ok) = Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> (Bool -> Event) -> Bool -> IO Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Event
Compress (Bool -> IO Event) -> Bool -> IO Event
forall a b. (a -> b) -> a -> b
$ CUChar
ok CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== 1

convertEventT (T.Environ cmd :: ECmd
cmd (values :: Ptr TelnetEnvironT
values, size :: CSize
size)) = do
  [TelnetEnvironT]
environs <- Int -> Ptr TelnetEnvironT -> IO [TelnetEnvironT]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) Ptr TelnetEnvironT
values
  if | ECmd
cmd ECmd -> ECmd -> Bool
forall a. Eq a => a -> a -> Bool
== ECmd
T.eCmdSend -> do
         [(Var, ByteString)]
vars <- (TelnetEnvironT -> IO (Var, ByteString))
-> [TelnetEnvironT] -> IO [(Var, ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TelnetEnvironT -> IO (Var, ByteString)
packVar [TelnetEnvironT]
environs
         Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ [(Var, ByteString)] -> Event
EnvironSend [(Var, ByteString)]
vars
     | ECmd
cmd ECmd -> [ECmd] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ECmd
T.eCmdIs, ECmd
T.eCmdInfo] -> do
         IsInfo
isInfo <- if | ECmd
cmd ECmd -> ECmd -> Bool
forall a. Eq a => a -> a -> Bool
== ECmd
T.eCmdIs -> IsInfo -> IO IsInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsInfo
Is
                      | ECmd
cmd ECmd -> ECmd -> Bool
forall a. Eq a => a -> a -> Bool
== ECmd
T.eCmdInfo -> IsInfo -> IO IsInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsInfo
Info
                      | Bool
otherwise -> TelnetException -> IO IsInfo
forall e a. Exception e => e -> IO a
throwIO (TelnetException -> IO IsInfo) -> TelnetException -> IO IsInfo
forall a b. (a -> b) -> a -> b
$ ECmd -> TelnetException
T.UnexpectedEnvironCmd ECmd
cmd
         [(Var, ByteString, ByteString)]
vars <- (TelnetEnvironT -> IO (Var, ByteString, ByteString))
-> [TelnetEnvironT] -> IO [(Var, ByteString, ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TelnetEnvironT -> IO (Var, ByteString, ByteString)
packVarVal [TelnetEnvironT]
environs
         Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ IsInfo -> [(Var, ByteString, ByteString)] -> Event
Environ IsInfo
isInfo [(Var, ByteString, ByteString)]
vars
     | Bool
otherwise -> TelnetException -> IO Event
forall e a. Exception e => e -> IO a
throwIO (TelnetException -> IO Event) -> TelnetException -> IO Event
forall a b. (a -> b) -> a -> b
$ ECmd -> TelnetException
T.UnexpectedEnvironCmd ECmd
cmd

convertEventT (T.Mssp (values :: Ptr TelnetEnvironT
values, size :: CSize
size)) = do
  [TelnetEnvironT]
environs <- Int -> Ptr TelnetEnvironT -> IO [TelnetEnvironT]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) Ptr TelnetEnvironT
values
  [(ByteString, ByteString)]
packed <- (TelnetEnvironT -> IO (ByteString, ByteString))
-> [TelnetEnvironT] -> IO [(ByteString, ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TelnetEnvironT -> IO (ByteString, ByteString)
packVarVal' [TelnetEnvironT]
environs

  let grouped :: [[(ByteString, ByteString)]]
grouped = ((ByteString, ByteString) -> (ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [[(ByteString, ByteString)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ByteString -> ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, ByteString)]
packed

      extract :: [(a, b)] -> (a, [b])
extract [] = String -> (a, [b])
forall a. HasCallStack => String -> a
error "Grouping should have made lists nonempty!"
      extract ((var :: a
var, val :: b
val):vals :: [(a, b)]
vals) = (a
var, b
val b -> [b] -> [b]
forall a. a -> [a] -> [a]
: ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
vals)

  Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> IO Event)
-> ([(ByteString, [ByteString])] -> Event)
-> [(ByteString, [ByteString])]
-> IO Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, [ByteString])] -> Event
Mssp ([(ByteString, [ByteString])] -> IO Event)
-> [(ByteString, [ByteString])] -> IO Event
forall a b. (a -> b) -> a -> b
$ ([(ByteString, ByteString)] -> (ByteString, [ByteString]))
-> [[(ByteString, ByteString)]] -> [(ByteString, [ByteString])]
forall a b. (a -> b) -> [a] -> [b]
map [(ByteString, ByteString)] -> (ByteString, [ByteString])
forall a b. [(a, b)] -> (a, [b])
extract [[(ByteString, ByteString)]]
grouped

varToEvar :: Var -> T.EVar
varToEvar :: Var -> EVar
varToEvar Var = EVar
T.eVar
varToEvar UserVar = EVar
T.eUserVar

eVarToVar :: T.EVar -> Var
eVarToVar :: EVar -> Var
eVarToVar var :: EVar
var
  | EVar
var EVar -> EVar -> Bool
forall a. Eq a => a -> a -> Bool
== EVar
T.eVar = Var
Var
  | EVar
var EVar -> EVar -> Bool
forall a. Eq a => a -> a -> Bool
== EVar
T.eUserVar = Var
UserVar
  | Bool
otherwise = TelnetException -> Var
forall a e. Exception e => e -> a
throw (TelnetException -> Var) -> TelnetException -> Var
forall a b. (a -> b) -> a -> b
$ EVar -> TelnetException
T.UnexpectedEnvironVar EVar
var

-- | Convert 'T.ErrorT' into managed strings.
packErrorT :: T.ErrorT -> IO Err
packErrorT :: ErrorT -> IO Err
packErrorT T.ErrorT{..} = do
  ByteString
file <- CString -> IO ByteString
B8.packCString CString
_file
  ByteString
func <- CString -> IO ByteString
B8.packCString CString
_func
  ByteString
msg <- CString -> IO ByteString
B8.packCString CString
_msg
  Err -> IO Err
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Err -> IO Err) -> Err -> IO Err
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString -> ByteString -> Int -> TelnetErrorT -> Err
Err ByteString
file ByteString
func ByteString
msg (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
_line) TelnetErrorT
_errcode

-- | Convert 'T.TelnetEnvironT' representing a request for an
-- environment var.
packVar :: T.TelnetEnvironT -> IO (Var, ByteString)
packVar :: TelnetEnvironT -> IO (Var, ByteString)
packVar T.TelnetEnvironT{..} = do
  ByteString
var <- CString -> IO ByteString
B8.packCString CString
_var
  (Var, ByteString) -> IO (Var, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EVar -> Var
eVarToVar EVar
_type, ByteString
var)

-- | Convert 'T.TelnetEnvironT' representing a message about an
-- environment var's value.
packVarVal :: T.TelnetEnvironT -> IO (Var, ByteString, ByteString)
packVarVal :: TelnetEnvironT -> IO (Var, ByteString, ByteString)
packVarVal T.TelnetEnvironT{..} = do
  ByteString
var <- CString -> IO ByteString
B8.packCString CString
_var
  ByteString
value <- CString -> IO ByteString
B8.packCString CString
_value
  (Var, ByteString, ByteString) -> IO (Var, ByteString, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EVar -> Var
eVarToVar EVar
_type, ByteString
var, ByteString
value)

-- | Convert 'T.TelnetEnvironT' representing an MSSP message (i.e.,
-- type is undefined).
packVarVal' :: T.TelnetEnvironT -> IO (ByteString, ByteString)
packVarVal' :: TelnetEnvironT -> IO (ByteString, ByteString)
packVarVal' T.TelnetEnvironT{..} =
  (,) (ByteString -> ByteString -> (ByteString, ByteString))
-> IO ByteString -> IO (ByteString -> (ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
B8.packCString CString
_var IO (ByteString -> (ByteString, ByteString))
-> IO ByteString -> IO (ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO ByteString
B8.packCString CString
_value

-- | Turn your event handler into one that the FFI can handle.
convertEventHandler :: EventHandler -> F.TelnetEventHandlerT
convertEventHandler :: EventHandler -> TelnetEventHandlerT
convertEventHandler f :: EventHandler
f telnetP :: TelnetPtr
telnetP eventP :: Ptr EventT
eventP _ =
  Ptr EventT -> IO EventT
forall a. Storable a => Ptr a -> IO a
peek Ptr EventT
eventP IO EventT -> (EventT -> IO Event) -> IO Event
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EventT -> IO Event
convertEventT IO Event -> (Event -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EventHandler
f TelnetPtr
telnetP