{-# LINE 1 "src/Network/Telnet/LibTelnet/Ffi.hsc" #-}
{-|
Module      : Network.Telnet.LibTelnet.Ffi
Description : Low-level FFI binding
Copyright   : (c) 2017-2021 Jack Kelly
License     : GPL-3.0-or-later
Maintainer  : jack@jackkelly.name
Stability   : experimental
Portability : non-portable

FFI binding to @libtelnet@. The vast majority of these functions are
generated from @foreign import@ declarations.
-}

module Network.Telnet.LibTelnet.Ffi where

import           Network.Telnet.LibTelnet.Iac (Iac(..), iacNull)
import           Network.Telnet.LibTelnet.Options (Option(..))
import qualified Network.Telnet.LibTelnet.Types as T

import           Control.Exception (throwIO)
import           Control.Monad (when)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.List (genericLength)
import           Foreign hiding (newForeignPtr)
import           Foreign.C (CSize(..), CString, CUChar(..))
import           Foreign.Concurrent (newForeignPtr)



-- | Wrap 'cTelnetInit'.
telnetInit
  :: [T.TelnetTeloptT]
  -> TelnetEventHandlerT
  -> [T.Flag]
  -> IO (ForeignPtr T.TelnetT)
telnetInit :: [TelnetTeloptT]
-> TelnetEventHandlerT -> [Flag] -> IO (ForeignPtr TelnetT)
telnetInit options :: [TelnetTeloptT]
options handler :: TelnetEventHandlerT
handler flags :: [Flag]
flags = do
  Ptr TelnetTeloptT
optionsA <- TelnetTeloptT -> [TelnetTeloptT] -> IO (Ptr TelnetTeloptT)
forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 (CShort -> Iac -> Iac -> TelnetTeloptT
T.TelnetTeloptT (-1) Iac
iacNull Iac
iacNull) [TelnetTeloptT]
options
  FunPtr TelnetEventHandlerT
handlerP <- TelnetEventHandlerT -> IO (FunPtr TelnetEventHandlerT)
wrapEventHandler TelnetEventHandlerT
handler
  let flagsC :: CUChar
flagsC = (Flag -> CUChar -> CUChar) -> CUChar -> [Flag] -> CUChar
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CUChar -> CUChar -> CUChar
forall a. Bits a => a -> a -> a
(.|.) (CUChar -> CUChar -> CUChar)
-> (Flag -> CUChar) -> Flag -> CUChar -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> CUChar
T.unFlag) 0 [Flag]
flags
  Ptr TelnetT
telnet <- Ptr TelnetTeloptT
-> FunPtr TelnetEventHandlerT
-> CUChar
-> Ptr ()
-> IO (Ptr TelnetT)
cTelnetInit Ptr TelnetTeloptT
optionsA FunPtr TelnetEventHandlerT
handlerP CUChar
flagsC Ptr ()
forall a. Ptr a
nullPtr
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr TelnetT
telnet Ptr TelnetT -> Ptr TelnetT -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr TelnetT
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TelnetException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TelnetException
T.NullTelnetPtr

  Ptr TelnetT -> IO () -> IO (ForeignPtr TelnetT)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr TelnetT
telnet (IO () -> IO (ForeignPtr TelnetT))
-> IO () -> IO (ForeignPtr TelnetT)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TelnetT -> IO ()
cTelnetFree Ptr TelnetT
telnet
    FunPtr TelnetEventHandlerT -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr TelnetEventHandlerT
handlerP
    Ptr TelnetTeloptT -> IO ()
forall a. Ptr a -> IO ()
free Ptr TelnetTeloptT
optionsA

-- | C function @telnet_init@.
foreign import ccall "libtelnet.h telnet_init"
  cTelnetInit
    :: Ptr T.TelnetTeloptT -- ^ @const telnet_telopt_t *telopts@
    -> FunPtr TelnetEventHandlerT -- ^ @telnet_event_handler_t eh@
    -> CUChar -- ^ @unsigned char flags@
    -> Ptr () -- ^ @void *user_data@
    -> IO (Ptr T.TelnetT)

-- | C function @telnet_free@.
foreign import ccall "libtelnet.h telnet_free"
  cTelnetFree :: Ptr T.TelnetT -> IO ()

-- | Represents @telnet_event_handler_t@.
type TelnetEventHandlerT = Ptr T.TelnetT -> Ptr T.EventT -> Ptr () -> IO ()

-- | Wrap an 'TelnetEventHandlerT' to pass to C code.
foreign import ccall "wrapper"
  wrapEventHandler :: TelnetEventHandlerT -> IO (FunPtr TelnetEventHandlerT)

-- | Wrap 'cTelnetRecv'.
telnetRecv :: Ptr T.TelnetT -> ByteString -> IO ()
telnetRecv :: Ptr TelnetT -> ByteString -> IO ()
telnetRecv telnetP :: Ptr TelnetT
telnetP bs :: ByteString
bs = ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \(buffer :: Ptr CChar
buffer, size :: Int
size) -> Ptr TelnetT -> Ptr CChar -> CSize -> IO ()
cTelnetRecv Ptr TelnetT
telnetP Ptr CChar
buffer (CSize -> IO ()) -> CSize -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size

-- | C function @telnet_recv@.
foreign import ccall "libtelnet.h telnet_recv"
  cTelnetRecv
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | C function @telnet_iac@.
foreign import ccall "libtelnet.h telnet_iac"
  cTelnetIac
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Iac -- ^ @unsigned char cmd@
    -> IO ()

-- | C function @telnet_negotiate@.
foreign import ccall "libtelnet.h telnet_negotiate"
  cTelnetNegotiate
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Iac -- ^ unsigned char cmd
    -> Option -- ^ unsigned char opt
    -> IO ()

-- | Wrap 'cTelnetSend'.
telnetSend :: Ptr T.TelnetT -> ByteString -> IO ()
telnetSend :: Ptr TelnetT -> ByteString -> IO ()
telnetSend telnetP :: Ptr TelnetT
telnetP bs :: ByteString
bs = ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \(buffer :: Ptr CChar
buffer, size :: Int
size) -> Ptr TelnetT -> Ptr CChar -> CSize -> IO ()
cTelnetSend Ptr TelnetT
telnetP Ptr CChar
buffer (CSize -> IO ()) -> CSize -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size

-- | C function @telnet_send@.
foreign import ccall "libtelnet.h telnet_send"
  cTelnetSend
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | Wrap 'cTelnetSubnegotiation'.
telnetSubnegotiation :: Ptr T.TelnetT -> Option -> ByteString -> IO ()
telnetSubnegotiation :: Ptr TelnetT -> Option -> ByteString -> IO ()
telnetSubnegotiation telnetP :: Ptr TelnetT
telnetP opt :: Option
opt bs :: ByteString
bs = ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \(buffer :: Ptr CChar
buffer, size :: Int
size) ->
      Ptr TelnetT -> Option -> Ptr CChar -> CSize -> IO ()
cTelnetSubnegotiation Ptr TelnetT
telnetP Option
opt Ptr CChar
buffer (CSize -> IO ()) -> CSize -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size

-- | C function @telnet_subnegotiation@.
foreign import ccall "libtelnet.h telnet_subnegotiation"
  cTelnetSubnegotiation
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> Option -- ^ @unsigned char telopt@
    -> CString -- ^ @const char *buffer@
    -> CSize -- ^ @size_t size@
    -> IO ()

-- | C function @telnet_begin_compress2@.
foreign import ccall "libtelnet.h telnet_begin_compress2"
  cTelnetBeginCompress2
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> IO ()

-- | C function @telnet_begin_newenviron@.
foreign import ccall "libtelnet.h telnet_begin_newenviron"
  cTelnetBeginNewEnviron
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> T.ECmd -- ^ @unsigned char type@
    -> IO ()

-- | C function @telnet_newenviron_value@.
foreign import ccall "libtelnet.h telnet_newenviron_value"
  cTelnetNewEnvironValue
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> T.EVar -- ^ @unsigned char type@
    -> CString -- ^ @const char *string@
    -> IO ()

-- | C function @telnet_ttype_send@.
foreign import ccall "libtelnet.h telnet_ttype_send"
  cTelnetTTypeSend
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> IO ()

-- | C function @telnet_ttype_is@.
foreign import ccall "libtelnet.h telnet_ttype_is"
  cTelnetTTypeIs
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CString -- ^ @const char *ttype@
    -> IO ()

-- | Wrap 'cTelnetSendZmp'.
telnetSendZmp :: Ptr T.TelnetT -> [ByteString] -> IO ()
telnetSendZmp :: Ptr TelnetT -> [ByteString] -> IO ()
telnetSendZmp telnetP :: Ptr TelnetT
telnetP cmd :: [ByteString]
cmd = [ByteString] -> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a. [ByteString] -> (Ptr (Ptr CChar) -> IO a) -> IO a
useAsCStrings [ByteString]
cmd ((Ptr (Ptr CChar) -> IO ()) -> IO ())
-> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \cCmd :: Ptr (Ptr CChar)
cCmd -> Ptr TelnetT -> CSize -> Ptr (Ptr CChar) -> IO ()
cTelnetSendZmp Ptr TelnetT
telnetP ([ByteString] -> CSize
forall i a. Num i => [a] -> i
genericLength [ByteString]
cmd) Ptr (Ptr CChar)
cCmd

-- | C function @telnet_send_zmp@.
foreign import ccall "libtelnet.h telnet_send_zmp"
  cTelnetSendZmp
    :: Ptr T.TelnetT -- ^ @telnet_t *telnet@
    -> CSize -- ^ @size_t argc@
    -> Ptr CString -- ^ @const char **argv@
    -> IO ()

-- | Collect '[ByteString]' into a temporary array of strings in a
-- 'Ptr CString', for passing to C functions.
useAsCStrings :: [ByteString] -> (Ptr CString -> IO a) -> IO a
useAsCStrings :: [ByteString] -> (Ptr (Ptr CChar) -> IO a) -> IO a
useAsCStrings list :: [ByteString]
list f :: Ptr (Ptr CChar) -> IO a
f = [ByteString] -> [Ptr CChar] -> IO a
go [ByteString]
list [] where
  go :: [ByteString] -> [Ptr CChar] -> IO a
go [] css :: [Ptr CChar]
css = [Ptr CChar] -> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ([Ptr CChar] -> [Ptr CChar]
forall a. [a] -> [a]
reverse [Ptr CChar]
css) Ptr (Ptr CChar) -> IO a
f
  go (bs :: ByteString
bs:bss :: [ByteString]
bss) css :: [Ptr CChar]
css = ByteString -> (Ptr CChar -> IO a) -> IO a
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.useAsCString ByteString
bs ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \cs :: Ptr CChar
cs -> [ByteString] -> [Ptr CChar] -> IO a
go [ByteString]
bss (Ptr CChar
csPtr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
:[Ptr CChar]
css)