Ffi.hsc

-- | FFI binding to @libtelnet@.

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)

#include <libtelnet.h>

-- | Wrap 'cTelnetInit'.
telnetInit
  :: [T.TelnetTeloptT]
  -> TelnetEventHandlerT
  -> [T.Flag]
  -> IO (ForeignPtr T.TelnetT)
telnetInit options handler flags = do
  optionsA <- newArray0 (T.TelnetTeloptT (-1) iacNull iacNull) options
  handlerP <- wrapEventHandler handler
  let flagsC = foldr ((.|.) . T.unFlag) 0 flags
  telnet <- cTelnetInit optionsA handlerP flagsC nullPtr
  when (telnet == nullPtr) $ throwIO T.NullTelnetPtr

  newForeignPtr telnet $ do
    cTelnetFree telnet
    freeHaskellFunPtr handlerP
    free 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 telnetP bs = B.useAsCStringLen bs $
    \(buffer, size) -> cTelnetRecv telnetP buffer $ fromIntegral 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 telnetP bs = B.useAsCStringLen bs $
    \(buffer, size) -> cTelnetSend telnetP buffer $ fromIntegral 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 telnetP opt bs = B.useAsCStringLen bs $
    \(buffer, size) ->
      cTelnetSubnegotiation telnetP opt buffer $ fromIntegral 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 telnetP cmd = useAsCStrings cmd $
    \cCmd -> cTelnetSendZmp telnetP (genericLength cmd) 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', to passing to C functions.
useAsCStrings :: [ByteString] -> (Ptr CString -> IO a) -> IO a
useAsCStrings list f = go list [] where
  go [] css = withArray (reverse css) f
  go (bs:bss) css = B.useAsCString bs $ \cs -> go bss (cs:css)