{-# LANGUAGE DeriveGeneric #-}
module Netcode.IO.Packet where

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


import Data.Word (Word8, Word64)
import Foreign.ForeignPtr (ForeignPtr)
import GHC.Generics (Generic)

import Bindings.Netcode.IO

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


-- | A packet is a basic unit of data that is transferred between client and

-- server. Sequence numbers indicate the order in which the packets were sent,

-- and this library contains no guarantee that they will be received in a

-- monotonically increasing order.

data Packet = Packet {
    -- | The sequence number for this packet.

    Packet -> Word64
packetSequenceNumber :: Word64,
    -- | The size, in bytes, of the data stored at 'packetDataPtr'

    Packet -> Int
packetSize :: Int,
    -- | A pointer to the bytes that are contained in this packet. This can be

    -- cast to any pointer type for the purposes of deseralizing, but this

    -- pointer must outlive the amount of time that this library has been

    -- initialized.

    Packet -> ForeignPtr Word8
packetDataPtr :: ForeignPtr Word8
} deriving (Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Packet] -> ShowS
$cshowList :: [Packet] -> ShowS
show :: Packet -> String
$cshow :: Packet -> String
showsPrec :: Int -> Packet -> ShowS
$cshowsPrec :: Int -> Packet -> ShowS
Show, (forall x. Packet -> Rep Packet x)
-> (forall x. Rep Packet x -> Packet) -> Generic Packet
forall x. Rep Packet x -> Packet
forall x. Packet -> Rep Packet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Packet x -> Packet
$cfrom :: forall x. Packet -> Rep Packet x
Generic)

-- | The maximum size, in bytes, of a packet. In other words, this is the

-- maximum value that 'packetSize' can take.

maximumPacketSize :: Num a => a
maximumPacketSize :: a
maximumPacketSize = a
forall a. Num a => a
c'NETCODE_MAX_PACKET_SIZE