{-|

Module      : Reliable.IO
Description : High-level bindings to the reliable.io library.
Copyright   : (c) Pavel Krajcevski, 2020
License     : BSD-3
Maintainer  : krajcevski@gmail.com
Stability   : experimental
Portability : Portable

This module contains the high-level bindings on top of the module
"Bindings.Netcode.IO". These provide a cleaner interface to the
<https://github.com/networkprotocol/reliable.io reliable.io> C library and are
the recommended interface for application developers.

These bindings have some limitations. Namely, they are not as performant as
the "close to the metal" bindings provided in "Bindings.Reliable.IO". In the
event that you need more performance, that module is available for use.

This library is intended to be used with a way to send and receive fixed size
packets over an unreliable channel. If such an interface exists, then, assuming
that the two parties are in constant communication, this library will do the
following for you:

    1. Break a packet down into a sequence of fixed size fragments to match
       your data channel size.
    2. Determine whether or not a sent packet has been acked by the receiver.
    3. Reassemble a packet once all fragments have been received.

With this in mind, the singular datatype provided by this library is an
'Endpoint'. Each endpoint requires the following:

    * How to send packet fragments ('TransmitPacketFunction')
    * What to do with reassembled packets ('ProcessPacketFunction')

Once you have an 'Endpoint', the two main operations that you would do with it
are to send a (possibly very large) packet ('sendPacket'), and provide it with
(possibly just one) packet fragments ('receivePacket'). On top of this library,
if a user would like to create a fully-reliable data channel (a la TCP), it
is that user's responsibility to identify when a packet has been dropped or has
arrived out of order to resend the appropriate packet.
-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Reliable.IO (
  -- * Initialization

    initialize
  , terminate

  -- * Utilities

  , LogLevel(..)
  , logLevel

  -- * Endpoint Configuration

  , EndpointConfig
  , defaultConfig
  , setName
  , setMaxPacketSize
  , setPacketFragmentationLimit
  , setPacketFragmentSize
  , setMaxNumFragments
  , setAckBufferSize
  , setSentPacketsBufferSize
  , setReceivedPacketsBufferSize
  , setFragmentReassemblyBufferSize
  , setRTTSmoothingFactor
  , setPacketLossSmoothingFactor
  , setBandwidthSmoothingFactor
  , PacketType(..)
  , setPacketType

  -- * Callbacks

  , TransmitPacketFunction
  , ProcessPacketFunction
  
  -- * Endpoints

  , Endpoint
  , createEndpoint
  , destroyEndpoint
  , withEndpoint
  , nextPacketSequence
  , sendPacket
  , receivePacket
  , getAcks
  , clearAcks
  , reset
  , update

  -- * Analytics

  , roundTripTime
  , packetLoss

  , BandwidthMeasurements(..)
  , bandwidth

  , Counter(..)
  , getCounter

) where 

-------------------------------------------------------------------------------


import Control.Monad         (when, unless)
import Data.Bool             (bool)
import Data.Data             (Data)
import Data.Typeable         (Typeable)
import Data.Word             (Word8, Word16, Word64)
import GHC.Generics          (Generic)
import GHC.Ptr               (Ptr)
import Foreign.C.String      (withCStringLen)
import Foreign.C.Types       (CInt, CDouble(..), CFloat(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray)
import Foreign.Ptr           (freeHaskellFunPtr)
import Foreign.Storable      (poke, Storable(..))

import Bindings.Reliable.IO

-------------------------------------------------------------------------------


-- | Initializes the @reliable.io@ library runtime. This should be called before

-- any additional functions in this library. Throws an

-- t'Control.Exception.IOException' on failure.

initialize :: IO ()
initialize :: IO ()
initialize = do
    CInt
result <- IO CInt
c'reliable_init
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'RELIABLE_OK) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to initialize reliable.io. Result: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
result
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Terminates the @reliable.io@ library runtime. This should be called only

-- after all other library functions terminate.

terminate :: IO ()
terminate :: IO ()
terminate = IO ()
c'reliable_term

-- | Specifies the logging behavior of @reliable.io@. Note, this logging behavior

-- is called from C calls to @printf@ and therefore might interfere with the

-- Haskell runtime (such as 'putStrLn').

data LogLevel = LogLevel'None
              | LogLevel'Info
              | LogLevel'Error
              | LogLevel'Debug
    deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel -> String -> String
[LogLevel] -> String -> String
LogLevel -> String
(Int -> LogLevel -> String -> String)
-> (LogLevel -> String)
-> ([LogLevel] -> String -> String)
-> Show LogLevel
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LogLevel] -> String -> String
$cshowList :: [LogLevel] -> String -> String
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> String -> String
$cshowsPrec :: Int -> LogLevel -> String -> String
Show, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLevel]
$creadListPrec :: ReadPrec [LogLevel]
readPrec :: ReadPrec LogLevel
$creadPrec :: ReadPrec LogLevel
readList :: ReadS [LogLevel]
$creadList :: ReadS [LogLevel]
readsPrec :: Int -> ReadS LogLevel
$creadsPrec :: Int -> ReadS LogLevel
Read, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, (forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogLevel x -> LogLevel
$cfrom :: forall x. LogLevel -> Rep LogLevel x
Generic, Typeable LogLevel
DataType
Constr
Typeable LogLevel
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LogLevel -> c LogLevel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LogLevel)
-> (LogLevel -> Constr)
-> (LogLevel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LogLevel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogLevel))
-> ((forall b. Data b => b -> b) -> LogLevel -> LogLevel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LogLevel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LogLevel -> r)
-> (forall u. (forall d. Data d => d -> u) -> LogLevel -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LogLevel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel)
-> Data LogLevel
LogLevel -> DataType
LogLevel -> Constr
(forall b. Data b => b -> b) -> LogLevel -> LogLevel
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogLevel -> c LogLevel
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LogLevel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LogLevel -> u
forall u. (forall d. Data d => d -> u) -> LogLevel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LogLevel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogLevel -> c LogLevel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LogLevel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogLevel)
$cLogLevel'Debug :: Constr
$cLogLevel'Error :: Constr
$cLogLevel'Info :: Constr
$cLogLevel'None :: Constr
$tLogLevel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
gmapMp :: (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
gmapM :: (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LogLevel -> m LogLevel
gmapQi :: Int -> (forall d. Data d => d -> u) -> LogLevel -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LogLevel -> u
gmapQ :: (forall d. Data d => d -> u) -> LogLevel -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LogLevel -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogLevel -> r
gmapT :: (forall b. Data b => b -> b) -> LogLevel -> LogLevel
$cgmapT :: (forall b. Data b => b -> b) -> LogLevel -> LogLevel
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogLevel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogLevel)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LogLevel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LogLevel)
dataTypeOf :: LogLevel -> DataType
$cdataTypeOf :: LogLevel -> DataType
toConstr :: LogLevel -> Constr
$ctoConstr :: LogLevel -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LogLevel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LogLevel
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogLevel -> c LogLevel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogLevel -> c LogLevel
$cp1Data :: Typeable LogLevel
Data, Typeable)

-- | Set the @reliable.io@ 'LogLevel'. The default is 'LogLevel'None'.

logLevel :: LogLevel -> IO ()
logLevel :: LogLevel -> IO ()
logLevel LogLevel
LogLevel'None  = CInt -> IO ()
c'reliable_log_level CInt
forall a. Num a => a
c'RELIABLE_LOG_LEVEL_NONE
logLevel LogLevel
LogLevel'Info  = CInt -> IO ()
c'reliable_log_level CInt
forall a. Num a => a
c'RELIABLE_LOG_LEVEL_INFO
logLevel LogLevel
LogLevel'Error = CInt -> IO ()
c'reliable_log_level CInt
forall a. Num a => a
c'RELIABLE_LOG_LEVEL_ERROR
logLevel LogLevel
LogLevel'Debug = CInt -> IO ()
c'reliable_log_level CInt
forall a. Num a => a
c'RELIABLE_LOG_LEVEL_DEBUG

-- | An 'EndpointConfig' is a write-only opaque datatype that is used to define

-- the settings for creating an 'Endpoint'.

newtype EndpointConfig = EndpointConfig { 
    EndpointConfig -> Ptr C'reliable_config_t -> IO ()
generateConfig :: Ptr C'reliable_config_t -> IO ()
    }

-- | The default 'EndpointConfig'. This uses sensible defaults for the library

-- (as opposed to being zero-initialized, for example).

defaultConfig :: EndpointConfig
defaultConfig :: EndpointConfig
defaultConfig = (Ptr C'reliable_config_t -> IO ()) -> EndpointConfig
EndpointConfig Ptr C'reliable_config_t -> IO ()
c'reliable_default_config

-- | Sets the name of the endpoint. This is usually not relevant, except when

-- setting the log level to be more than 'LogLevel'None'.

setName :: String -> EndpointConfig -> EndpointConfig
setName :: String -> EndpointConfig -> EndpointConfig
setName String
s (EndpointConfig Ptr C'reliable_config_t -> IO ()
fn) = (Ptr C'reliable_config_t -> IO ()) -> EndpointConfig
EndpointConfig ((Ptr C'reliable_config_t -> IO ()) -> EndpointConfig)
-> (Ptr C'reliable_config_t -> IO ()) -> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'reliable_config_t
cfgPtr -> do
    Ptr C'reliable_config_t -> IO ()
fn Ptr C'reliable_config_t
cfgPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Endpoint config name too long"
    String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
s ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
csPtr, Int
csLen) -> do
        C'reliable_config_t
config <- Ptr C'reliable_config_t -> IO C'reliable_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'reliable_config_t
cfgPtr
        [CChar]
cs <- Int -> Ptr CChar -> IO [CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
csLen Ptr CChar
csPtr
        Ptr C'reliable_config_t -> C'reliable_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'reliable_config_t
cfgPtr (C'reliable_config_t -> IO ()) -> C'reliable_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'reliable_config_t
config { c'reliable_config_t'name :: [CChar]
c'reliable_config_t'name = ([CChar]
cs [CChar] -> [CChar] -> [CChar]
forall a. Semigroup a => a -> a -> a
<> [CChar
0]) }

-- Helper function to convert transforms on C structs into transforms on

-- Haskell datatypes.

setConfig :: (C'reliable_config_t -> C'reliable_config_t)
          -> EndpointConfig -> EndpointConfig
setConfig :: (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig -> EndpointConfig
setConfig C'reliable_config_t -> C'reliable_config_t
fn (EndpointConfig Ptr C'reliable_config_t -> IO ()
mkCfg) = (Ptr C'reliable_config_t -> IO ()) -> EndpointConfig
EndpointConfig ((Ptr C'reliable_config_t -> IO ()) -> EndpointConfig)
-> (Ptr C'reliable_config_t -> IO ()) -> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'reliable_config_t
cfgPtr ->
    Ptr C'reliable_config_t -> IO ()
mkCfg Ptr C'reliable_config_t
cfgPtr IO () -> IO C'reliable_config_t -> IO C'reliable_config_t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr C'reliable_config_t -> IO C'reliable_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'reliable_config_t
cfgPtr IO C'reliable_config_t -> (C'reliable_config_t -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr C'reliable_config_t -> C'reliable_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'reliable_config_t
cfgPtr (C'reliable_config_t -> IO ())
-> (C'reliable_config_t -> C'reliable_config_t)
-> C'reliable_config_t
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'reliable_config_t -> C'reliable_config_t
fn

-- Calls 'setConfig' with an Int value

setConfigIntVal :: (CInt -> C'reliable_config_t -> C'reliable_config_t)
                -> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal :: (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal CInt -> C'reliable_config_t -> C'reliable_config_t
fn Int
x = (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig -> EndpointConfig
setConfig ((C'reliable_config_t -> C'reliable_config_t)
 -> EndpointConfig -> EndpointConfig)
-> (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ CInt -> C'reliable_config_t -> C'reliable_config_t
fn (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)

-- Calls 'setConfig' with a Float value

setConfigFloatVal :: (CFloat -> C'reliable_config_t -> C'reliable_config_t)
                  -> Float -> EndpointConfig -> EndpointConfig
setConfigFloatVal :: (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float -> EndpointConfig -> EndpointConfig
setConfigFloatVal CFloat -> C'reliable_config_t -> C'reliable_config_t
fn Float
x = (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig -> EndpointConfig
setConfig ((C'reliable_config_t -> C'reliable_config_t)
 -> EndpointConfig -> EndpointConfig)
-> (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ CFloat -> C'reliable_config_t -> C'reliable_config_t
fn (Float -> CFloat
CFloat Float
x)

-- | Sets the maximum packet size for the endpoint. This will allow the API to

-- know when to throw an error when the packet being sent is too big. The

-- packet size is purely application specific, but may be useful for making

-- sure that your data sizes don't grow too large during development. The

-- default value for this is 16KB.

setMaxPacketSize :: Int -> EndpointConfig -> EndpointConfig
setMaxPacketSize :: Int -> EndpointConfig -> EndpointConfig
setMaxPacketSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'max_packet_size :: CInt
c'reliable_config_t'max_packet_size = CInt
sz }

-- | Sets the fragmentation limit for this endpoint. The fragmentation limit is

-- the size in bytes for a packet where it will be split into multiple

-- fragments. This need not be @maxPacketSize / maxNumFragments@, but that is

-- usually a sensible choice. The default value is 1KB.

setPacketFragmentationLimit :: Int -> EndpointConfig -> EndpointConfig
setPacketFragmentationLimit :: Int -> EndpointConfig -> EndpointConfig
setPacketFragmentationLimit = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
l C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'fragment_above :: CInt
c'reliable_config_t'fragment_above = CInt
l }

-- | Sets the fragment size for this endpoint. The fragment size determines the

-- size in bytes of each fragment. This need not be the same as the

-- fragmentation limit, although that is certainly a sensible choice. The

-- default for this value is 1KB.

setPacketFragmentSize :: Int -> EndpointConfig -> EndpointConfig
setPacketFragmentSize :: Int -> EndpointConfig -> EndpointConfig
setPacketFragmentSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'fragment_size :: CInt
c'reliable_config_t'fragment_size = CInt
sz }

-- | Sets the number of fragments per packet in this endpoint. This is only to

-- make sure that the endpoint has enough buffer space provisioned for incoming

-- packets. Default for this value is 16, and the maximum value is 256.

setMaxNumFragments :: Int -> EndpointConfig -> EndpointConfig
setMaxNumFragments :: Int -> EndpointConfig -> EndpointConfig
setMaxNumFragments = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
n C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'max_fragments :: CInt
c'reliable_config_t'max_fragments = CInt
n }

-- | Sets the number of packets for which to store received sequence numbers.

-- The default value is 256.

setAckBufferSize :: Int -> EndpointConfig -> EndpointConfig
setAckBufferSize :: Int -> EndpointConfig -> EndpointConfig
setAckBufferSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'ack_buffer_size :: CInt
c'reliable_config_t'ack_buffer_size = CInt
sz }

-- | Sets the maximum number of packets for which to store sent packet info.

-- This number reflects the largest number of packets we expect to be in flight

-- at any given time, in order to properly ack them upon receipt of some other

-- endpoint's packets. Also useful for properly computing bandwidth of the

-- endpoint. Default value is 256.

setSentPacketsBufferSize :: Int -> EndpointConfig -> EndpointConfig
setSentPacketsBufferSize :: Int -> EndpointConfig -> EndpointConfig
setSentPacketsBufferSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'sent_packets_buffer_size :: CInt
c'reliable_config_t'sent_packets_buffer_size = CInt
sz }

-- | Sets the maximum number of packets for which to store received packet

-- info. Useful for properly acking packets and for accurately computing

-- bandwidth of the endpoint. Default value is 256.

setReceivedPacketsBufferSize :: Int -> EndpointConfig -> EndpointConfig
setReceivedPacketsBufferSize :: Int -> EndpointConfig -> EndpointConfig
setReceivedPacketsBufferSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'received_packets_buffer_size :: CInt
c'reliable_config_t'received_packets_buffer_size = CInt
sz }

-- | Sets the maximum number of in flight packet fragments that we can store

-- in order to properly recreate the packets upon receipt. This buffer is used

-- to process out of order and dropped packets, as fragments from a packet may

-- not arrive contiguously. Default value is 64.

setFragmentReassemblyBufferSize :: Int -> EndpointConfig -> EndpointConfig
setFragmentReassemblyBufferSize :: Int -> EndpointConfig -> EndpointConfig
setFragmentReassemblyBufferSize = (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int -> EndpointConfig -> EndpointConfig
setConfigIntVal ((CInt -> C'reliable_config_t -> C'reliable_config_t)
 -> Int -> EndpointConfig -> EndpointConfig)
-> (CInt -> C'reliable_config_t -> C'reliable_config_t)
-> Int
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CInt
sz C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'fragment_reassembly_buffer_size :: CInt
c'reliable_config_t'fragment_reassembly_buffer_size = CInt
sz }

-- | Sets the round trip time smoothing factor. This is purely for diagnostic

-- purposes when determining what the round trip time is for this endpoint.

-- Smaller numbers will vary the RTT measurement more slowly. Default value is

-- 0.0025f.

setRTTSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setRTTSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setRTTSmoothingFactor = (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float -> EndpointConfig -> EndpointConfig
setConfigFloatVal ((CFloat -> C'reliable_config_t -> C'reliable_config_t)
 -> Float -> EndpointConfig -> EndpointConfig)
-> (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CFloat
factor C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'rtt_smoothing_factor :: CFloat
c'reliable_config_t'rtt_smoothing_factor = CFloat
factor }

-- | Sets the packet loss smoothing factor. This is purely for diagnostic

-- purposes when determining what the packet loss rate is for this endpoint.

-- Smaller numbers will vary the packet loss measurement more slowly.

-- Default value is 0.1f.

setPacketLossSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setPacketLossSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setPacketLossSmoothingFactor = (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float -> EndpointConfig -> EndpointConfig
setConfigFloatVal ((CFloat -> C'reliable_config_t -> C'reliable_config_t)
 -> Float -> EndpointConfig -> EndpointConfig)
-> (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CFloat
factor C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'packet_loss_smoothing_factor :: CFloat
c'reliable_config_t'packet_loss_smoothing_factor = CFloat
factor }

-- | Sets the bandwidth smoothing factor. This is purely for diagnostic

-- purposes when determining what the bandwidth is from this endpoint. Smaller

-- numbers will vary the bandwidth measurement more slowly. Default value is

-- 0.1f.

setBandwidthSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setBandwidthSmoothingFactor :: Float -> EndpointConfig -> EndpointConfig
setBandwidthSmoothingFactor = (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float -> EndpointConfig -> EndpointConfig
setConfigFloatVal ((CFloat -> C'reliable_config_t -> C'reliable_config_t)
 -> Float -> EndpointConfig -> EndpointConfig)
-> (CFloat -> C'reliable_config_t -> C'reliable_config_t)
-> Float
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \CFloat
factor C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'bandwidth_smoothing_factor :: CFloat
c'reliable_config_t'bandwidth_smoothing_factor = CFloat
factor }

-- | Endpoints support two packet types, either IPV4 or IPV6.

data PacketType = PacketType'IPV4 | PacketType'IPV6
    deriving (PacketType -> PacketType -> Bool
(PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> Bool) -> Eq PacketType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PacketType -> PacketType -> Bool
$c/= :: PacketType -> PacketType -> Bool
== :: PacketType -> PacketType -> Bool
$c== :: PacketType -> PacketType -> Bool
Eq, Eq PacketType
Eq PacketType
-> (PacketType -> PacketType -> Ordering)
-> (PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> PacketType)
-> (PacketType -> PacketType -> PacketType)
-> Ord PacketType
PacketType -> PacketType -> Bool
PacketType -> PacketType -> Ordering
PacketType -> PacketType -> PacketType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PacketType -> PacketType -> PacketType
$cmin :: PacketType -> PacketType -> PacketType
max :: PacketType -> PacketType -> PacketType
$cmax :: PacketType -> PacketType -> PacketType
>= :: PacketType -> PacketType -> Bool
$c>= :: PacketType -> PacketType -> Bool
> :: PacketType -> PacketType -> Bool
$c> :: PacketType -> PacketType -> Bool
<= :: PacketType -> PacketType -> Bool
$c<= :: PacketType -> PacketType -> Bool
< :: PacketType -> PacketType -> Bool
$c< :: PacketType -> PacketType -> Bool
compare :: PacketType -> PacketType -> Ordering
$ccompare :: PacketType -> PacketType -> Ordering
$cp1Ord :: Eq PacketType
Ord, Int -> PacketType -> String -> String
[PacketType] -> String -> String
PacketType -> String
(Int -> PacketType -> String -> String)
-> (PacketType -> String)
-> ([PacketType] -> String -> String)
-> Show PacketType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PacketType] -> String -> String
$cshowList :: [PacketType] -> String -> String
show :: PacketType -> String
$cshow :: PacketType -> String
showsPrec :: Int -> PacketType -> String -> String
$cshowsPrec :: Int -> PacketType -> String -> String
Show, ReadPrec [PacketType]
ReadPrec PacketType
Int -> ReadS PacketType
ReadS [PacketType]
(Int -> ReadS PacketType)
-> ReadS [PacketType]
-> ReadPrec PacketType
-> ReadPrec [PacketType]
-> Read PacketType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PacketType]
$creadListPrec :: ReadPrec [PacketType]
readPrec :: ReadPrec PacketType
$creadPrec :: ReadPrec PacketType
readList :: ReadS [PacketType]
$creadList :: ReadS [PacketType]
readsPrec :: Int -> ReadS PacketType
$creadsPrec :: Int -> ReadS PacketType
Read, PacketType
PacketType -> PacketType -> Bounded PacketType
forall a. a -> a -> Bounded a
maxBound :: PacketType
$cmaxBound :: PacketType
minBound :: PacketType
$cminBound :: PacketType
Bounded, Int -> PacketType
PacketType -> Int
PacketType -> [PacketType]
PacketType -> PacketType
PacketType -> PacketType -> [PacketType]
PacketType -> PacketType -> PacketType -> [PacketType]
(PacketType -> PacketType)
-> (PacketType -> PacketType)
-> (Int -> PacketType)
-> (PacketType -> Int)
-> (PacketType -> [PacketType])
-> (PacketType -> PacketType -> [PacketType])
-> (PacketType -> PacketType -> [PacketType])
-> (PacketType -> PacketType -> PacketType -> [PacketType])
-> Enum PacketType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PacketType -> PacketType -> PacketType -> [PacketType]
$cenumFromThenTo :: PacketType -> PacketType -> PacketType -> [PacketType]
enumFromTo :: PacketType -> PacketType -> [PacketType]
$cenumFromTo :: PacketType -> PacketType -> [PacketType]
enumFromThen :: PacketType -> PacketType -> [PacketType]
$cenumFromThen :: PacketType -> PacketType -> [PacketType]
enumFrom :: PacketType -> [PacketType]
$cenumFrom :: PacketType -> [PacketType]
fromEnum :: PacketType -> Int
$cfromEnum :: PacketType -> Int
toEnum :: Int -> PacketType
$ctoEnum :: Int -> PacketType
pred :: PacketType -> PacketType
$cpred :: PacketType -> PacketType
succ :: PacketType -> PacketType
$csucc :: PacketType -> PacketType
Enum, (forall x. PacketType -> Rep PacketType x)
-> (forall x. Rep PacketType x -> PacketType) -> Generic PacketType
forall x. Rep PacketType x -> PacketType
forall x. PacketType -> Rep PacketType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PacketType x -> PacketType
$cfrom :: forall x. PacketType -> Rep PacketType x
Generic, Typeable PacketType
DataType
Constr
Typeable PacketType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PacketType -> c PacketType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PacketType)
-> (PacketType -> Constr)
-> (PacketType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PacketType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PacketType))
-> ((forall b. Data b => b -> b) -> PacketType -> PacketType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PacketType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PacketType -> r)
-> (forall u. (forall d. Data d => d -> u) -> PacketType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PacketType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PacketType -> m PacketType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PacketType -> m PacketType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PacketType -> m PacketType)
-> Data PacketType
PacketType -> DataType
PacketType -> Constr
(forall b. Data b => b -> b) -> PacketType -> PacketType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PacketType -> c PacketType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PacketType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PacketType -> u
forall u. (forall d. Data d => d -> u) -> PacketType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PacketType -> m PacketType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PacketType -> m PacketType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PacketType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PacketType -> c PacketType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PacketType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PacketType)
$cPacketType'IPV6 :: Constr
$cPacketType'IPV4 :: Constr
$tPacketType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PacketType -> m PacketType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PacketType -> m PacketType
gmapMp :: (forall d. Data d => d -> m d) -> PacketType -> m PacketType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PacketType -> m PacketType
gmapM :: (forall d. Data d => d -> m d) -> PacketType -> m PacketType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PacketType -> m PacketType
gmapQi :: Int -> (forall d. Data d => d -> u) -> PacketType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PacketType -> u
gmapQ :: (forall d. Data d => d -> u) -> PacketType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PacketType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PacketType -> r
gmapT :: (forall b. Data b => b -> b) -> PacketType -> PacketType
$cgmapT :: (forall b. Data b => b -> b) -> PacketType -> PacketType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PacketType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PacketType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PacketType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PacketType)
dataTypeOf :: PacketType -> DataType
$cdataTypeOf :: PacketType -> DataType
toConstr :: PacketType -> Constr
$ctoConstr :: PacketType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PacketType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PacketType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PacketType -> c PacketType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PacketType -> c PacketType
$cp1Data :: Typeable PacketType
Data, Typeable)

-- | Sets the packet type for this endpoint, which determines the header size

-- that the library needs to allocate in order to properly keep track of the

-- packets.

setPacketType :: PacketType -> EndpointConfig -> EndpointConfig
setPacketType :: PacketType -> EndpointConfig -> EndpointConfig
setPacketType PacketType
PacketType'IPV4 = (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig -> EndpointConfig
setConfig ((C'reliable_config_t -> C'reliable_config_t)
 -> EndpointConfig -> EndpointConfig)
-> (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'packet_header_size :: CInt
c'reliable_config_t'packet_header_size = CInt
28 }
setPacketType PacketType
PacketType'IPV6 = (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig -> EndpointConfig
setConfig ((C'reliable_config_t -> C'reliable_config_t)
 -> EndpointConfig -> EndpointConfig)
-> (C'reliable_config_t -> C'reliable_config_t)
-> EndpointConfig
-> EndpointConfig
forall a b. (a -> b) -> a -> b
$ \C'reliable_config_t
config ->
    C'reliable_config_t
config { c'reliable_config_t'packet_header_size :: CInt
c'reliable_config_t'packet_header_size = CInt
48 }
    
-- Utility structure to know what to free when destroying endpoints.

data EndpointCallbacks = EndpointCallbacks
    { EndpointCallbacks -> C'transmit_packet_function_t
_endpointCallbacksXmit :: C'transmit_packet_function_t
    , EndpointCallbacks -> C'process_packet_function_t
_endpointCallbacksRecv :: C'process_packet_function_t
    }

-- | An 'Endpoint' is the main datatype of the reliable.io library. Two

-- endpoints (usually, but not exclusively) on separate hosts represent a

-- connection over an unreliable network, such as the UDP protocol over the

-- internet. The function of an endpoint is to provide a way to administer

-- traffic to the corresponding receiver. It is not responsible for performing

-- the actual sending and receiving of data.

--

-- Endpoints provide two main services:

--

--   1. Breaking down a large packet into fragments, each of which is a

--      predetermined size.

--   2. Assembling a sequence of fragments from a corresponding endpoint.

--   3. Notifying the user when a packet has been received (ack'd) by the

--      corresponding endpoint.

--

-- Packets to be disassembled into fragments and transmitted are passed to the

-- endpoint via the 'sendPacket' function. Fragments that are received from the

-- corresponding endpoint and should be reassmbled are passed to the endpoint

-- via the 'receivePacket' function. These functions only queue the data for

-- processing, but the actual processing of packets only takes place during a

-- call to 'update'.

--

-- Additionally, each 'Endpoint' keeps track of the metrics associated with it,

-- providing the user with ways to measure the round trip time for each packet,

-- the bandwidth of the connection, and a measurement of the packet loss.

data Endpoint = Endpoint
    { Endpoint -> Ptr C'reliable_endpoint_t
_endpointPtr :: Ptr C'reliable_endpoint_t
    , Endpoint -> EndpointCallbacks
_endpointCallbacks :: EndpointCallbacks
    }

-- | Function used by an 'Endpoint' to send packet fragments over the

-- unreliable data channel. One use case would be to have the given data sent

-- to a UDP socket.

type TransmitPacketFunction
     = Word16     -- ^ Sequence number of the packet being sent

    -> Ptr Word8  -- ^ Pointer to memory containing the packet data

    -> Int        -- ^ Size of the data in bytes

    -> IO ()

-- Utility function for converting TransmitPacketFunctions to the C callback

-- type.

mkTransmitPacketFunction :: TransmitPacketFunction
                         -> IO C'transmit_packet_function_t
mkTransmitPacketFunction :: TransmitPacketFunction -> IO C'transmit_packet_function_t
mkTransmitPacketFunction TransmitPacketFunction
fn = (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ())
-> IO C'transmit_packet_function_t
mk'transmit_packet_function_t ((Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ())
 -> IO C'transmit_packet_function_t)
-> (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ())
-> IO C'transmit_packet_function_t
forall a b. (a -> b) -> a -> b
$
    \Ptr ()
_ CInt
_ Word16
seqNo Ptr Word8
ptr -> TransmitPacketFunction
fn Word16
seqNo Ptr Word8
ptr (Int -> IO ()) -> (CInt -> Int) -> CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | A user function supplied to an 'Endpoint' that handles reassembled packets

-- once they've been received.

type ProcessPacketFunction
     = Word16     -- ^ Sequence number of the packet received.

    -> Ptr Word8  -- ^ Pointer to the memory containing the packet data

    -> Int        -- ^ Size of the data in bytes.

    -> IO Bool    -- ^ Returns true if the packet was successfully processed


-- Utility function for converting ProcessPacketFunctions to the C callback type.

mkProcessPacketFunction :: ProcessPacketFunction -> IO C'process_packet_function_t
mkProcessPacketFunction :: ProcessPacketFunction -> IO C'process_packet_function_t
mkProcessPacketFunction ProcessPacketFunction
fn = (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt)
-> IO C'process_packet_function_t
mk'process_packet_function_t ((Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt)
 -> IO C'process_packet_function_t)
-> (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt)
-> IO C'process_packet_function_t
forall a b. (a -> b) -> a -> b
$
    \Ptr ()
_ CInt
_ Word16
seqNo Ptr Word8
ptr -> (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool -> CInt
forall a. a -> a -> Bool -> a
bool CInt
0 CInt
1) (IO Bool -> IO CInt) -> (CInt -> IO Bool) -> CInt -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessPacketFunction
fn Word16
seqNo Ptr Word8
ptr (Int -> IO Bool) -> (CInt -> Int) -> CInt -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Creates an 'Endpoint'. The two main callbacks required for each endpoint:

--

--   1. A 'TransmitPacketFunction' that is able to send packet fragments to a

--      corresponding 'Endpoint'

--   2. A 'ProcessPacketFunction' that administers the reassmbled packet from a

--      collection of fragments.

--

-- The 'Double' parameter corresponds to the time (in seconds) at which the

-- endpoint is created. This time value is needed to be in the same domain to

-- subsequent calls to 'update' in order to properly calculate metrics.

createEndpoint :: EndpointConfig
               -> Double
               -> TransmitPacketFunction
               -> ProcessPacketFunction
               -> IO Endpoint
createEndpoint :: EndpointConfig
-> Double
-> TransmitPacketFunction
-> ProcessPacketFunction
-> IO Endpoint
createEndpoint EndpointConfig
cfg Double
t TransmitPacketFunction
xmitFn ProcessPacketFunction
recvFn = (Ptr C'reliable_config_t -> IO Endpoint) -> IO Endpoint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'reliable_config_t -> IO Endpoint) -> IO Endpoint)
-> (Ptr C'reliable_config_t -> IO Endpoint) -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ \Ptr C'reliable_config_t
ptr -> do
    EndpointConfig -> Ptr C'reliable_config_t -> IO ()
generateConfig EndpointConfig
cfg Ptr C'reliable_config_t
ptr
    C'reliable_config_t
config <- Ptr C'reliable_config_t -> IO C'reliable_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'reliable_config_t
ptr
    C'transmit_packet_function_t
xmitCFn <- TransmitPacketFunction -> IO C'transmit_packet_function_t
mkTransmitPacketFunction TransmitPacketFunction
xmitFn
    C'process_packet_function_t
recvCFn <- ProcessPacketFunction -> IO C'process_packet_function_t
mkProcessPacketFunction ProcessPacketFunction
recvFn
    Ptr C'reliable_config_t -> C'reliable_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'reliable_config_t
ptr (C'reliable_config_t -> IO ()) -> C'reliable_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'reliable_config_t
config {
        c'reliable_config_t'transmit_packet_function :: C'transmit_packet_function_t
c'reliable_config_t'transmit_packet_function = C'transmit_packet_function_t
xmitCFn,
        c'reliable_config_t'process_packet_function :: C'process_packet_function_t
c'reliable_config_t'process_packet_function = C'process_packet_function_t
recvCFn
    }
    Ptr C'reliable_endpoint_t
endpoint <- Ptr C'reliable_config_t
-> CDouble -> IO (Ptr C'reliable_endpoint_t)
c'reliable_endpoint_create Ptr C'reliable_config_t
ptr (Double -> CDouble
CDouble Double
t)
    Endpoint -> IO Endpoint
forall (m :: * -> *) a. Monad m => a -> m a
return (Endpoint -> IO Endpoint) -> Endpoint -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ Ptr C'reliable_endpoint_t -> EndpointCallbacks -> Endpoint
Endpoint Ptr C'reliable_endpoint_t
endpoint (C'transmit_packet_function_t
-> C'process_packet_function_t -> EndpointCallbacks
EndpointCallbacks C'transmit_packet_function_t
xmitCFn C'process_packet_function_t
recvCFn)

-- | Destroys an 'Endpoint' and any associated callbacks.

destroyEndpoint :: Endpoint -> IO ()
destroyEndpoint :: Endpoint -> IO ()
destroyEndpoint (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
cbs) = do
    Ptr C'reliable_endpoint_t -> IO ()
c'reliable_endpoint_destroy Ptr C'reliable_endpoint_t
ptr
    C'transmit_packet_function_t -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr (C'transmit_packet_function_t -> IO ())
-> C'transmit_packet_function_t -> IO ()
forall a b. (a -> b) -> a -> b
$ EndpointCallbacks -> C'transmit_packet_function_t
_endpointCallbacksXmit EndpointCallbacks
cbs
    C'process_packet_function_t -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr (C'process_packet_function_t -> IO ())
-> C'process_packet_function_t -> IO ()
forall a b. (a -> b) -> a -> b
$ EndpointCallbacks -> C'process_packet_function_t
_endpointCallbacksRecv EndpointCallbacks
cbs
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Convenience function that follows the

-- <https://wiki.haskell.org/Bracket_pattern Bracket pattern> for encapsulating

-- the resource management associated with interfacing with an 'Endpoint'.

withEndpoint :: EndpointConfig
             -> Double
             -> TransmitPacketFunction
             -> ProcessPacketFunction
             -> (Endpoint -> IO a)
             -> IO a
withEndpoint :: EndpointConfig
-> Double
-> TransmitPacketFunction
-> ProcessPacketFunction
-> (Endpoint -> IO a)
-> IO a
withEndpoint EndpointConfig
cfg Double
t TransmitPacketFunction
xmit ProcessPacketFunction
recv Endpoint -> IO a
fn = do
    Endpoint
endpoint <- EndpointConfig
-> Double
-> TransmitPacketFunction
-> ProcessPacketFunction
-> IO Endpoint
createEndpoint EndpointConfig
cfg Double
t TransmitPacketFunction
xmit ProcessPacketFunction
recv
    a
result <- Endpoint -> IO a
fn Endpoint
endpoint
    Endpoint -> IO ()
destroyEndpoint Endpoint
endpoint
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Returns the sequence number of the next packet that will be sent from this

-- 'Endpoint'.

nextPacketSequence :: Endpoint -> IO Word16
nextPacketSequence :: Endpoint -> IO Word16
nextPacketSequence (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) =
    Ptr C'reliable_endpoint_t -> IO Word16
c'reliable_endpoint_next_packet_sequence Ptr C'reliable_endpoint_t
ptr

-- | @sendPacket e p sz@ will send a packet from 'Endpoint' @e@ with @sz@ bytes

-- whose data resides in the memory pointed to by @p@. If @sz@ is larger than

-- the fragment limit, the packet will be split into multiple fragments. Each

-- fragment will then be sent via the 'TransmitPacketFunction' passed to

-- 'createEndpoint'. Note, this function does not actually send the packet, and

-- rather queues it for sending during the next call to 'update'.

sendPacket :: Endpoint -> Ptr Word8 -> Int -> IO ()
sendPacket :: Endpoint -> Ptr Word8 -> Int -> IO ()
sendPacket (Endpoint Ptr C'reliable_endpoint_t
epPtr EndpointCallbacks
_) Ptr Word8
pktPtr =
    Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ()
c'reliable_endpoint_send_packet Ptr C'reliable_endpoint_t
epPtr Ptr Word8
pktPtr (CInt -> IO ()) -> (Int -> CInt) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @receivePacket e p sz@ will add a packet fragment to 'Endpoint' @e@ with

-- @sz@ bytes whose data resides in the memory pointed to by @p@. Once all of

-- the fragments of a given packet have been received via this function, the

-- 'Endpoint' will pass the reassembled packet to the 'ProcessPacketFunction'

-- passed to 'createEndpoint'. Note, this function does not actually reassemble

-- the packet, and rather queues it for processing during the next call to

-- 'update'.

receivePacket :: Endpoint -> Ptr Word8 -> Int -> IO ()
receivePacket :: Endpoint -> Ptr Word8 -> Int -> IO ()
receivePacket (Endpoint Ptr C'reliable_endpoint_t
epPtr EndpointCallbacks
_) Ptr Word8
pktPtr =
    Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ()
c'reliable_endpoint_receive_packet Ptr C'reliable_endpoint_t
epPtr Ptr Word8
pktPtr (CInt -> IO ()) -> (Int -> CInt) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Returns the list of sequence numbers for the most recently ack'd packets

-- that have been sent from this 'Endpoint'.

getAcks :: Endpoint -> IO [Word16]
getAcks :: Endpoint -> IO [Word16]
getAcks (Endpoint Ptr C'reliable_endpoint_t
epPtr EndpointCallbacks
_) = (Ptr CInt -> IO [Word16]) -> IO [Word16]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [Word16]) -> IO [Word16])
-> (Ptr CInt -> IO [Word16]) -> IO [Word16]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
numAcksPtr -> do
    Ptr Word16
acksPtr <- Ptr C'reliable_endpoint_t -> Ptr CInt -> IO (Ptr Word16)
c'reliable_endpoint_get_acks Ptr C'reliable_endpoint_t
epPtr Ptr CInt
numAcksPtr
    CInt
numAcks <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
numAcksPtr
    Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
numAcks) Ptr Word16
acksPtr

-- | Clears the list of sequence numbers for the most recently ack'd packets.

clearAcks :: Endpoint -> IO ()
clearAcks :: Endpoint -> IO ()
clearAcks (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) = Ptr C'reliable_endpoint_t -> IO ()
c'reliable_endpoint_clear_acks Ptr C'reliable_endpoint_t
ptr

-- | Resets the endpoint, including all metrics about network traffic and any

-- information about ack'd packets.

reset :: Endpoint -> IO ()
reset :: Endpoint -> IO ()
reset (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) = Ptr C'reliable_endpoint_t -> IO ()
c'reliable_endpoint_reset Ptr C'reliable_endpoint_t
ptr

-- | Performs the work of updating the endpoint. This sends packets,

-- reassembles packets, and identifies any acks received from the corresponding

-- 'Endpoint'. The time passed to this function must be measured in seconds and

-- correspond to the same time domain as 'createEndpoint'.

update :: Endpoint -> Double -> IO ()
update :: Endpoint -> Double -> IO ()
update (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) = Ptr C'reliable_endpoint_t -> CDouble -> IO ()
c'reliable_endpoint_update Ptr C'reliable_endpoint_t
ptr (CDouble -> IO ()) -> (Double -> CDouble) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
CDouble

-- | Returns the measured round trip time for packets sent from this

-- 'Endpoint'.

roundTripTime :: Endpoint -> IO Float
roundTripTime :: Endpoint -> IO Float
roundTripTime (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) = do
    (CFloat Float
f) <- Ptr C'reliable_endpoint_t -> IO CFloat
c'reliable_endpoint_rtt Ptr C'reliable_endpoint_t
ptr
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
f

-- | Returns the measured packet loss for packets sent from this 'Endpoint'.

packetLoss :: Endpoint -> IO Float
packetLoss :: Endpoint -> IO Float
packetLoss (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) = do
    (CFloat Float
f) <- Ptr C'reliable_endpoint_t -> IO CFloat
c'reliable_endpoint_packet_loss Ptr C'reliable_endpoint_t
ptr
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
f

-- | Bandwidth measurements taken for each 'Endpoint'.

data BandwidthMeasurements = BandwidthMeasurements
    { BandwidthMeasurements -> Float
bandwidthSentKbps :: Float
    , BandwidthMeasurements -> Float
bandwidthReceivedKbps :: Float
    , BandwidthMeasurements -> Float
bandwidthAckedKbps :: Float
    } deriving (Int -> BandwidthMeasurements -> String -> String
[BandwidthMeasurements] -> String -> String
BandwidthMeasurements -> String
(Int -> BandwidthMeasurements -> String -> String)
-> (BandwidthMeasurements -> String)
-> ([BandwidthMeasurements] -> String -> String)
-> Show BandwidthMeasurements
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BandwidthMeasurements] -> String -> String
$cshowList :: [BandwidthMeasurements] -> String -> String
show :: BandwidthMeasurements -> String
$cshow :: BandwidthMeasurements -> String
showsPrec :: Int -> BandwidthMeasurements -> String -> String
$cshowsPrec :: Int -> BandwidthMeasurements -> String -> String
Show, ReadPrec [BandwidthMeasurements]
ReadPrec BandwidthMeasurements
Int -> ReadS BandwidthMeasurements
ReadS [BandwidthMeasurements]
(Int -> ReadS BandwidthMeasurements)
-> ReadS [BandwidthMeasurements]
-> ReadPrec BandwidthMeasurements
-> ReadPrec [BandwidthMeasurements]
-> Read BandwidthMeasurements
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BandwidthMeasurements]
$creadListPrec :: ReadPrec [BandwidthMeasurements]
readPrec :: ReadPrec BandwidthMeasurements
$creadPrec :: ReadPrec BandwidthMeasurements
readList :: ReadS [BandwidthMeasurements]
$creadList :: ReadS [BandwidthMeasurements]
readsPrec :: Int -> ReadS BandwidthMeasurements
$creadsPrec :: Int -> ReadS BandwidthMeasurements
Read, (forall x. BandwidthMeasurements -> Rep BandwidthMeasurements x)
-> (forall x. Rep BandwidthMeasurements x -> BandwidthMeasurements)
-> Generic BandwidthMeasurements
forall x. Rep BandwidthMeasurements x -> BandwidthMeasurements
forall x. BandwidthMeasurements -> Rep BandwidthMeasurements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BandwidthMeasurements x -> BandwidthMeasurements
$cfrom :: forall x. BandwidthMeasurements -> Rep BandwidthMeasurements x
Generic)

-- | Returns the measured bandwidth for data on this 'Endpoint'.

bandwidth :: Endpoint -> IO BandwidthMeasurements
bandwidth :: Endpoint -> IO BandwidthMeasurements
bandwidth (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) =
    (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO BandwidthMeasurements)
 -> IO BandwidthMeasurements)
-> (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
sentPtr ->
    (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO BandwidthMeasurements)
 -> IO BandwidthMeasurements)
-> (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
receivedPtr ->
    (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO BandwidthMeasurements)
 -> IO BandwidthMeasurements)
-> (Ptr CFloat -> IO BandwidthMeasurements)
-> IO BandwidthMeasurements
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
ackedPtr -> do
        Ptr C'reliable_endpoint_t
-> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
c'reliable_endpoint_bandwidth Ptr C'reliable_endpoint_t
ptr Ptr CFloat
sentPtr Ptr CFloat
receivedPtr Ptr CFloat
ackedPtr
        (CFloat Float
sent) <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
sentPtr
        (CFloat Float
received) <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
receivedPtr
        (CFloat Float
acked) <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
ackedPtr
        BandwidthMeasurements -> IO BandwidthMeasurements
forall (m :: * -> *) a. Monad m => a -> m a
return (BandwidthMeasurements -> IO BandwidthMeasurements)
-> BandwidthMeasurements -> IO BandwidthMeasurements
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> BandwidthMeasurements
BandwidthMeasurements Float
sent Float
received Float
acked

-- | Counters for metrics that are collected for each 'Endpoint'. These are

-- reset upon calling 'reset' for the given 'Endpoint'.

data Counter
    = Counter'NumPacketsSent
    | Counter'NumPacketsReceived
    | Counter'NumPacketsAcked
    | Counter'NumPacketsStale
    | Counter'NumPacketsInvalid
    | Counter'NumPacketsTooLargeToSend
    | Counter'NumPacketsTooLargeToReceive
    | Counter'NumFragmentsSent
    | Counter'NumFragmentsReceived
    | Counter'NumFragmentsInvalid
    deriving (Counter -> Counter -> Bool
(Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool) -> Eq Counter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c== :: Counter -> Counter -> Bool
Eq, Eq Counter
Eq Counter
-> (Counter -> Counter -> Ordering)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> Ord Counter
Counter -> Counter -> Bool
Counter -> Counter -> Ordering
Counter -> Counter -> Counter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Counter -> Counter -> Counter
$cmin :: Counter -> Counter -> Counter
max :: Counter -> Counter -> Counter
$cmax :: Counter -> Counter -> Counter
>= :: Counter -> Counter -> Bool
$c>= :: Counter -> Counter -> Bool
> :: Counter -> Counter -> Bool
$c> :: Counter -> Counter -> Bool
<= :: Counter -> Counter -> Bool
$c<= :: Counter -> Counter -> Bool
< :: Counter -> Counter -> Bool
$c< :: Counter -> Counter -> Bool
compare :: Counter -> Counter -> Ordering
$ccompare :: Counter -> Counter -> Ordering
$cp1Ord :: Eq Counter
Ord, Int -> Counter -> String -> String
[Counter] -> String -> String
Counter -> String
(Int -> Counter -> String -> String)
-> (Counter -> String)
-> ([Counter] -> String -> String)
-> Show Counter
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Counter] -> String -> String
$cshowList :: [Counter] -> String -> String
show :: Counter -> String
$cshow :: Counter -> String
showsPrec :: Int -> Counter -> String -> String
$cshowsPrec :: Int -> Counter -> String -> String
Show, ReadPrec [Counter]
ReadPrec Counter
Int -> ReadS Counter
ReadS [Counter]
(Int -> ReadS Counter)
-> ReadS [Counter]
-> ReadPrec Counter
-> ReadPrec [Counter]
-> Read Counter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Counter]
$creadListPrec :: ReadPrec [Counter]
readPrec :: ReadPrec Counter
$creadPrec :: ReadPrec Counter
readList :: ReadS [Counter]
$creadList :: ReadS [Counter]
readsPrec :: Int -> ReadS Counter
$creadsPrec :: Int -> ReadS Counter
Read, Int -> Counter
Counter -> Int
Counter -> [Counter]
Counter -> Counter
Counter -> Counter -> [Counter]
Counter -> Counter -> Counter -> [Counter]
(Counter -> Counter)
-> (Counter -> Counter)
-> (Int -> Counter)
-> (Counter -> Int)
-> (Counter -> [Counter])
-> (Counter -> Counter -> [Counter])
-> (Counter -> Counter -> [Counter])
-> (Counter -> Counter -> Counter -> [Counter])
-> Enum Counter
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Counter -> Counter -> Counter -> [Counter]
$cenumFromThenTo :: Counter -> Counter -> Counter -> [Counter]
enumFromTo :: Counter -> Counter -> [Counter]
$cenumFromTo :: Counter -> Counter -> [Counter]
enumFromThen :: Counter -> Counter -> [Counter]
$cenumFromThen :: Counter -> Counter -> [Counter]
enumFrom :: Counter -> [Counter]
$cenumFrom :: Counter -> [Counter]
fromEnum :: Counter -> Int
$cfromEnum :: Counter -> Int
toEnum :: Int -> Counter
$ctoEnum :: Int -> Counter
pred :: Counter -> Counter
$cpred :: Counter -> Counter
succ :: Counter -> Counter
$csucc :: Counter -> Counter
Enum, Counter
Counter -> Counter -> Bounded Counter
forall a. a -> a -> Bounded a
maxBound :: Counter
$cmaxBound :: Counter
minBound :: Counter
$cminBound :: Counter
Bounded, (forall x. Counter -> Rep Counter x)
-> (forall x. Rep Counter x -> Counter) -> Generic Counter
forall x. Rep Counter x -> Counter
forall x. Counter -> Rep Counter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Counter x -> Counter
$cfrom :: forall x. Counter -> Rep Counter x
Generic, Typeable Counter
DataType
Constr
Typeable Counter
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Counter -> c Counter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Counter)
-> (Counter -> Constr)
-> (Counter -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Counter))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Counter))
-> ((forall b. Data b => b -> b) -> Counter -> Counter)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Counter -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Counter -> r)
-> (forall u. (forall d. Data d => d -> u) -> Counter -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Counter -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Counter -> m Counter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Counter -> m Counter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Counter -> m Counter)
-> Data Counter
Counter -> DataType
Counter -> Constr
(forall b. Data b => b -> b) -> Counter -> Counter
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Counter -> c Counter
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Counter
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Counter -> u
forall u. (forall d. Data d => d -> u) -> Counter -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Counter -> m Counter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Counter -> m Counter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Counter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Counter -> c Counter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Counter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Counter)
$cCounter'NumFragmentsInvalid :: Constr
$cCounter'NumFragmentsReceived :: Constr
$cCounter'NumFragmentsSent :: Constr
$cCounter'NumPacketsTooLargeToReceive :: Constr
$cCounter'NumPacketsTooLargeToSend :: Constr
$cCounter'NumPacketsInvalid :: Constr
$cCounter'NumPacketsStale :: Constr
$cCounter'NumPacketsAcked :: Constr
$cCounter'NumPacketsReceived :: Constr
$cCounter'NumPacketsSent :: Constr
$tCounter :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Counter -> m Counter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Counter -> m Counter
gmapMp :: (forall d. Data d => d -> m d) -> Counter -> m Counter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Counter -> m Counter
gmapM :: (forall d. Data d => d -> m d) -> Counter -> m Counter
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Counter -> m Counter
gmapQi :: Int -> (forall d. Data d => d -> u) -> Counter -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Counter -> u
gmapQ :: (forall d. Data d => d -> u) -> Counter -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Counter -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Counter -> r
gmapT :: (forall b. Data b => b -> b) -> Counter -> Counter
$cgmapT :: (forall b. Data b => b -> b) -> Counter -> Counter
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Counter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Counter)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Counter)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Counter)
dataTypeOf :: Counter -> DataType
$cdataTypeOf :: Counter -> DataType
toConstr :: Counter -> Constr
$ctoConstr :: Counter -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Counter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Counter
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Counter -> c Counter
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Counter -> c Counter
$cp1Data :: Typeable Counter
Data, Typeable)

-- | Returns the counter value associated with the 'Counter' for the given

-- 'Endpoint'.

getCounter :: Endpoint -> Counter -> IO Word64
getCounter :: Endpoint -> Counter -> IO Word64
getCounter (Endpoint Ptr C'reliable_endpoint_t
ptr EndpointCallbacks
_) Counter
ctr =
    let ctrIdx :: Int
ctrIdx = case Counter
ctr of
            Counter
Counter'NumPacketsSent              -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_SENT
            Counter
Counter'NumPacketsReceived          -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_RECEIVED
            Counter
Counter'NumPacketsAcked             -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_ACKED
            Counter
Counter'NumPacketsStale             -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_STALE
            Counter
Counter'NumPacketsInvalid           -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_INVALID
            Counter
Counter'NumPacketsTooLargeToSend    -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_SEND
            Counter
Counter'NumPacketsTooLargeToReceive -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_RECEIVE
            Counter
Counter'NumFragmentsSent            -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_SENT
            Counter
Counter'NumFragmentsReceived        -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_RECEIVED
            Counter
Counter'NumFragmentsInvalid         -> Int
forall a. Num a => a
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_INVALID
     in Ptr C'reliable_endpoint_t -> IO (Ptr Word64)
c'reliable_endpoint_counters Ptr C'reliable_endpoint_t
ptr IO (Ptr Word64) -> (Ptr Word64 -> IO Word64) -> IO Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr Word64 -> Int -> IO Word64) -> Int -> Ptr Word64 -> IO Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Int
ctrIdx