module Netcode.IO.Server (
    -- * Servers

    -- ** Server-specific callbacks
      ServerConnectDisconnectCallback

    -- ** Server configs
    , ServerConfig
    , defaultServerConfig
    , setProtocolID
    , setPrivateKey
    , setServerConnectDisconnectCallback, clearServerConnectDisconnectCallback
    , setServerSendReceiveOverrides, clearServerSendReceiveOverrides

    -- ** Server objects
    , Server
    , createServer
    , destroyServer
    , startServer
    , maxNumClients
    , stopServer
    , updateServer
    , clientConnectedAtIndex
    , clientIdAtIndex
    , withClientAddressAtIndex
    , withClientUserDataAtIndex
    , clientUserDataAtIndex
    , maxClientsForServer
    , numConnectedClients
    , isServerRunning
    , isServerFull
    , getServerPort
    , sendPacketFromServer
    , broadcastPacketFromServer
    , disconnectClientFromServer
    , disconnectAllClientsFromServer
    , receivePacketFromClient
    , nextServerPacketSequence
) where

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

import Control.Applicative   (liftA2)
import Control.Monad         (when, forM_)
import Data.Word             (Word8, Word16, Word64)
import Foreign.C.String      (withCString)
import Foreign.C.Types       (CDouble(..))
import Foreign.Concurrent    (newForeignPtr)
import Foreign.ForeignPtr    (newForeignPtr_)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray)
import Foreign.Ptr           ( Ptr, nullPtr, castPtr
                             , FunPtr, nullFunPtr, freeHaskellFunPtr
                             )
import Foreign.Storable      (peek, poke)

import Bindings.Netcode.IO
import Netcode.IO.Address
import Netcode.IO.Callbacks
import Netcode.IO.Packet

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

freeNullFunPtr :: FunPtr a -> IO ()
freeNullFunPtr :: FunPtr a -> IO ()
freeNullFunPtr FunPtr a
x
    | FunPtr a
x FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise       = FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
x

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

-- | A server object. This is an opaque type meant to be used in conjunction
-- with this library.
--
-- A server is generally meant to represent and endpoint for one or more
-- t'Network.IO.Client's to connect to. The server application is similar to
-- that of the client in that it is expected to have a running timer with a
-- resolution of at least seconds. The main loop of the server application is
-- meant to call 'updateServer' to allow the library to process incoming
-- packets and send outgoing packets to the clients.
data Server = Server 
    { Server -> Ptr C'netcode_server_t
serverPtr :: Ptr C'netcode_server_t
    , Server -> ServerCallbacks
serverCallbacks :: ServerCallbacks
    } deriving (Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show)

data ServerCallbacks = ServerCallbacks
    { ServerCallbacks -> C'connect_disconnect_callback_t
serverConnectDisconnect     :: C'connect_disconnect_callback_t
    , ServerCallbacks -> C'send_packet_override_t
serverSendPacketOverride    :: C'send_packet_override_t
    , ServerCallbacks -> C'receive_packet_override_t
serverReceivePacketOverride :: C'receive_packet_override_t
    } deriving (Int -> ServerCallbacks -> ShowS
[ServerCallbacks] -> ShowS
ServerCallbacks -> String
(Int -> ServerCallbacks -> ShowS)
-> (ServerCallbacks -> String)
-> ([ServerCallbacks] -> ShowS)
-> Show ServerCallbacks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerCallbacks] -> ShowS
$cshowList :: [ServerCallbacks] -> ShowS
show :: ServerCallbacks -> String
$cshow :: ServerCallbacks -> String
showsPrec :: Int -> ServerCallbacks -> ShowS
$cshowsPrec :: Int -> ServerCallbacks -> ShowS
Show)

defaultServerCallbacks :: ServerCallbacks
defaultServerCallbacks :: ServerCallbacks
defaultServerCallbacks = C'connect_disconnect_callback_t
-> C'send_packet_override_t
-> C'receive_packet_override_t
-> ServerCallbacks
ServerCallbacks C'connect_disconnect_callback_t
forall a. FunPtr a
nullFunPtr C'send_packet_override_t
forall a. FunPtr a
nullFunPtr C'receive_packet_override_t
forall a. FunPtr a
nullFunPtr

-- | A 'ServerConfig' is a type that specifies the behavior of a 'Server' and
-- contains associated metadata.
--
-- At a minimum, the connection protocol ID and the private key for the
-- application should be set for each server (via 'setProtocolID' and
-- 'setPrivateKey', respectively).
newtype ServerConfig = ServerConfig
    (   Ptr C'netcode_server_config_t
        -> ServerCallbacks
        -> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
    )

-- | The default 'ServerConfig' contains no callbacks or overrides, and
-- contains empty values for the required fields needed to properly have
-- a server respond to a connecting t'Netcode.IO.Client'.
defaultServerConfig :: ServerConfig
defaultServerConfig :: ServerConfig
defaultServerConfig = (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
cbs -> do
    Ptr C'netcode_server_config_t -> IO ()
c'netcode_default_server_config Ptr C'netcode_server_config_t
serverConfig
    (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
serverConfig, ServerCallbacks
cbs)

-- | Sets the connection protocol ID used by this 'Server'. This is a unique
-- ID that must match the protocol ID used in
-- 'Netcode.IO.generateConnectToken'
setProtocolID :: Word64 -> ServerConfig -> ServerConfig
setProtocolID :: Word64 -> ServerConfig -> ServerConfig
setProtocolID Word64
protocolID (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkServerPtr) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
cbs' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
cbs) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkServerPtr Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
cbs'
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$
            C'netcode_server_config_t
config { c'netcode_server_config_t'protocol_id :: Word64
c'netcode_server_config_t'protocol_id = Word64
protocolID }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
cbs)

-- | Sets the private key used by this 'Server'. This key must match the
-- private key used in 'Netcode.IO.generateConnectToken'
setPrivateKey :: [Word8] -> ServerConfig -> ServerConfig
setPrivateKey :: [Word8] -> ServerConfig -> ServerConfig
setPrivateKey [Word8]
key (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkServerPtr) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
cbs' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
cbs) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkServerPtr Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
cbs'
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$    
            C'netcode_server_config_t
config {
                c'netcode_server_config_t'private_key :: [Word8]
c'netcode_server_config_t'private_key = 
                    Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
forall a. Num a => a
c'NETCODE_KEY_BYTES ([Word8]
key [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Word8 -> [Word8]
forall a. a -> [a]
repeat Word8
0)
            }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
cbs)

-- | A server-specific callback that gets invoked each time a client either
-- connects to, or disconnects from, the server.
type ServerConnectDisconnectCallback
   = Int  -- ^ Client index connected
  -> Bool -- ^ True if the client connected
  -> IO ()

mkServerConnectDisconnectCallback :: ServerConnectDisconnectCallback
                                  -> IO C'connect_disconnect_callback_t
mkServerConnectDisconnectCallback :: ServerConnectDisconnectCallback
-> IO C'connect_disconnect_callback_t
mkServerConnectDisconnectCallback ServerConnectDisconnectCallback
cb = (Ptr () -> CInt -> CInt -> IO ())
-> IO C'connect_disconnect_callback_t
mk'connect_disconnect_callback_t ((Ptr () -> CInt -> CInt -> IO ())
 -> IO C'connect_disconnect_callback_t)
-> (Ptr () -> CInt -> CInt -> IO ())
-> IO C'connect_disconnect_callback_t
forall a b. (a -> b) -> a -> b
$
    \Ptr ()
_ CInt
clientIdx CInt
connected -> ServerConnectDisconnectCallback
cb (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
clientIdx) (CInt
connected CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)

-- | Replaces the existing 'ServerConnectDisconnectCallback' with the given one
-- and frees any associated memory that may be allocated for the the existing
-- callback.
setServerConnectDisconnectCallback :: ServerConnectDisconnectCallback
                                    -> ServerConfig -> ServerConfig
setServerConnectDisconnectCallback :: ServerConnectDisconnectCallback -> ServerConfig -> ServerConfig
setServerConnectDisconnectCallback ServerConnectDisconnectCallback
cb (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks'
        C'connect_disconnect_callback_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'connect_disconnect_callback_t -> IO ())
-> C'connect_disconnect_callback_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'connect_disconnect_callback_t
serverConnectDisconnect ServerCallbacks
callbacks
        C'connect_disconnect_callback_t
fPtr <- ServerConnectDisconnectCallback
-> IO C'connect_disconnect_callback_t
mkServerConnectDisconnectCallback ServerConnectDisconnectCallback
cb
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'netcode_server_config_t
config
            { c'netcode_server_config_t'connect_disconnect_callback :: C'connect_disconnect_callback_t
c'netcode_server_config_t'connect_disconnect_callback = C'connect_disconnect_callback_t
fPtr
            }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks { serverConnectDisconnect :: C'connect_disconnect_callback_t
serverConnectDisconnect = C'connect_disconnect_callback_t
fPtr })

-- | Removes the existing 'ServerConnectDisconnectCallback' and frees any
-- associated memory that may be allocated for the the existing callback.
clearServerConnectDisconnectCallback :: ServerConfig -> ServerConfig
clearServerConnectDisconnectCallback :: ServerConfig -> ServerConfig
clearServerConnectDisconnectCallback (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks'
        C'connect_disconnect_callback_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'connect_disconnect_callback_t -> IO ())
-> C'connect_disconnect_callback_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'connect_disconnect_callback_t
serverConnectDisconnect ServerCallbacks
callbacks
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'netcode_server_config_t
config
            { c'netcode_server_config_t'connect_disconnect_callback :: C'connect_disconnect_callback_t
c'netcode_server_config_t'connect_disconnect_callback = C'connect_disconnect_callback_t
forall a. FunPtr a
nullFunPtr
            }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks { serverConnectDisconnect :: C'connect_disconnect_callback_t
serverConnectDisconnect = C'connect_disconnect_callback_t
forall a. FunPtr a
nullFunPtr })

-- | Removes the existing send and receive overrides for the given config, if
-- set, and instead uses the ones given.
setServerSendReceiveOverrides :: SendPacketOverride
                            -> ReceivePacketOverride
                            -> ServerConfig -> ServerConfig
setServerSendReceiveOverrides :: SendPacketOverride
-> ReceivePacketOverride -> ServerConfig -> ServerConfig
setServerSendReceiveOverrides SendPacketOverride
sendFn ReceivePacketOverride
recvFn (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks'
        C'send_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'send_packet_override_t -> IO ())
-> C'send_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'send_packet_override_t
serverSendPacketOverride ServerCallbacks
callbacks
        C'receive_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'receive_packet_override_t -> IO ())
-> C'receive_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'receive_packet_override_t
serverReceivePacketOverride ServerCallbacks
callbacks
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        C'send_packet_override_t
sendOverride <- SendPacketOverride -> IO C'send_packet_override_t
mkSendPacketOverride SendPacketOverride
sendFn
        C'receive_packet_override_t
recvOverride <- ReceivePacketOverride -> IO C'receive_packet_override_t
mkReceivePacketOverride ReceivePacketOverride
recvFn
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'netcode_server_config_t
config
            { c'netcode_server_config_t'send_packet_override :: C'send_packet_override_t
c'netcode_server_config_t'send_packet_override = C'send_packet_override_t
sendOverride
            , c'netcode_server_config_t'receive_packet_override :: C'receive_packet_override_t
c'netcode_server_config_t'receive_packet_override = C'receive_packet_override_t
recvOverride
            , c'netcode_server_config_t'override_send_and_receive :: CInt
c'netcode_server_config_t'override_send_and_receive = CInt
1
            }
        let newcbs :: ServerCallbacks
newcbs = ServerCallbacks
callbacks
                { serverSendPacketOverride :: C'send_packet_override_t
serverSendPacketOverride = C'send_packet_override_t
sendOverride
                , serverReceivePacketOverride :: C'receive_packet_override_t
serverReceivePacketOverride = C'receive_packet_override_t
recvOverride
                }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
newcbs)

-- | Changes the config to use the default send and receive packet functions.
clearServerSendReceiveOverrides :: ServerConfig -> ServerConfig
clearServerSendReceiveOverrides :: ServerConfig -> ServerConfig
clearServerSendReceiveOverrides (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig) =
    (Ptr C'netcode_server_config_t
 -> ServerCallbacks
 -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
ServerConfig ((Ptr C'netcode_server_config_t
  -> ServerCallbacks
  -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
 -> ServerConfig)
-> (Ptr C'netcode_server_config_t
    -> ServerCallbacks
    -> IO (Ptr C'netcode_server_config_t, ServerCallbacks))
-> ServerConfig
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks' -> do
        (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
callbacks) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig Ptr C'netcode_server_config_t
configPtr' ServerCallbacks
callbacks'
        C'send_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'send_packet_override_t -> IO ())
-> C'send_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'send_packet_override_t
serverSendPacketOverride ServerCallbacks
callbacks
        C'receive_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'receive_packet_override_t -> IO ())
-> C'receive_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'receive_packet_override_t
serverReceivePacketOverride ServerCallbacks
callbacks
        C'netcode_server_config_t
config <- Ptr C'netcode_server_config_t -> IO C'netcode_server_config_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'netcode_server_config_t
configPtr
        Ptr C'netcode_server_config_t -> C'netcode_server_config_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'netcode_server_config_t
configPtr (C'netcode_server_config_t -> IO ())
-> C'netcode_server_config_t -> IO ()
forall a b. (a -> b) -> a -> b
$ C'netcode_server_config_t
config
            { c'netcode_server_config_t'send_packet_override :: C'send_packet_override_t
c'netcode_server_config_t'send_packet_override = C'send_packet_override_t
forall a. FunPtr a
nullFunPtr
            , c'netcode_server_config_t'receive_packet_override :: C'receive_packet_override_t
c'netcode_server_config_t'receive_packet_override = C'receive_packet_override_t
forall a. FunPtr a
nullFunPtr
            , c'netcode_server_config_t'override_send_and_receive :: CInt
c'netcode_server_config_t'override_send_and_receive = CInt
0
            }
        let newcbs :: ServerCallbacks
newcbs = ServerCallbacks
callbacks
                { serverSendPacketOverride :: C'send_packet_override_t
serverSendPacketOverride = C'send_packet_override_t
forall a. FunPtr a
nullFunPtr
                , serverReceivePacketOverride :: C'receive_packet_override_t
serverReceivePacketOverride = C'receive_packet_override_t
forall a. FunPtr a
nullFunPtr
                }
        (Ptr C'netcode_server_config_t, ServerCallbacks)
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_config_t
configPtr, ServerCallbacks
newcbs)

-- | Creates a server at the given address using the provided config. Throws an
-- IOException on failure.
--
-- Note, the address used here can be either formatted as an IPv4 address or an
-- IPv6 address, similar to the arguments passed to 'parseAddress'. In the
-- common case, you will likely want to use INADDR_ANY to bind to the
-- underlying socket, which is represented by the address "0.0.0.0"
--
-- The time passed to this create function should be a measurement in seconds,
-- such that when connecting in the future using 'updateServer', the same
-- resolution timer is being passed. That allows the library to properly
-- timeout in cases where connections are taking too long to establish.
createServer :: String -> ServerConfig -> Double -> IO Server
createServer :: String -> ServerConfig -> Double -> IO Server
createServer String
s (ServerConfig Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig) Double
time = (Ptr C'netcode_server_config_t -> IO Server) -> IO Server
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'netcode_server_config_t -> IO Server) -> IO Server)
-> (Ptr C'netcode_server_config_t -> IO Server) -> IO Server
forall a b. (a -> b) -> a -> b
$ \Ptr C'netcode_server_config_t
serverConfig -> do
    (Ptr C'netcode_server_config_t
config, ServerCallbacks
cbs) <- Ptr C'netcode_server_config_t
-> ServerCallbacks
-> IO (Ptr C'netcode_server_config_t, ServerCallbacks)
mkConfig Ptr C'netcode_server_config_t
serverConfig ServerCallbacks
defaultServerCallbacks
    Ptr C'netcode_server_t
ptr <- String
-> (CString -> IO (Ptr C'netcode_server_t))
-> IO (Ptr C'netcode_server_t)
forall a. String -> (CString -> IO a) -> IO a
withCString String
s (\CString
cs -> CString
-> Ptr C'netcode_server_config_t
-> CDouble
-> IO (Ptr C'netcode_server_t)
c'netcode_server_create CString
cs Ptr C'netcode_server_config_t
config (Double -> CDouble
CDouble Double
time))
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'netcode_server_t
ptr Ptr C'netcode_server_t -> Ptr C'netcode_server_t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'netcode_server_t
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to create server!"
    Server -> IO Server
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'netcode_server_t -> ServerCallbacks -> Server
Server Ptr C'netcode_server_t
ptr ServerCallbacks
cbs)

-- | Starts the server and specifies the maximum number of clients that can
-- connect. Emits a warning when the maximum number of clients is more than
-- 'maxNumClients'.
startServer :: Server -> Int -> IO ()
startServer :: Server -> Int -> IO ()
startServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) Int
n = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Num a => a
maxNumClients) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
          String
"Warning: Can only start server with at most "
        , Int -> String
forall a. Show a => a -> String
show (Int
forall a. Num a => a
maxNumClients :: Int), String
" clients. Requested: ", Int -> String
forall a. Show a => a -> String
show Int
n
        ]
    Ptr C'netcode_server_t -> CInt -> IO ()
c'netcode_server_start Ptr C'netcode_server_t
s (CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
min CInt
forall a. Num a => a
maxNumClients (CInt -> CInt) -> CInt -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

-- | Returns the maximum number of clients that a server can support.
maxNumClients :: Num a => a
maxNumClients :: a
maxNumClients = a
forall a. Num a => a
c'NETCODE_MAX_CLIENTS

-- | Stops the server.
stopServer :: Server -> IO ()
stopServer :: Server -> IO ()
stopServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) = Ptr C'netcode_server_t -> IO ()
c'netcode_server_stop Ptr C'netcode_server_t
s

-- | Destroys the server object and frees the associated Haskell-side callbacks
-- and overrides
destroyServer :: Server -> IO ()
destroyServer :: Server -> IO ()
destroyServer (Server Ptr C'netcode_server_t
s ServerCallbacks
cbs) = do
    Ptr C'netcode_server_t -> IO ()
c'netcode_server_destroy Ptr C'netcode_server_t
s
    C'connect_disconnect_callback_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'connect_disconnect_callback_t -> IO ())
-> C'connect_disconnect_callback_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'connect_disconnect_callback_t
serverConnectDisconnect ServerCallbacks
cbs
    C'send_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'send_packet_override_t -> IO ())
-> C'send_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'send_packet_override_t
serverSendPacketOverride ServerCallbacks
cbs
    C'receive_packet_override_t -> IO ()
forall a. FunPtr a -> IO ()
freeNullFunPtr (C'receive_packet_override_t -> IO ())
-> C'receive_packet_override_t -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerCallbacks -> C'receive_packet_override_t
serverReceivePacketOverride ServerCallbacks
cbs

-- | Main processing call for a 'Server' with the current time in seconds (in
-- the same domain as the time passed to 'createServer'). This flushes packet
-- queues at the appropriate rate and updates connection statuses among other
-- things. It is expected to be called in the main loop of the application.
updateServer :: Server -> Double -> IO ()
updateServer :: Server -> Double -> IO ()
updateServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) = Ptr C'netcode_server_t -> CDouble -> IO ()
c'netcode_server_update Ptr C'netcode_server_t
s (CDouble -> IO ()) -> (Double -> CDouble) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
CDouble

-- | Returns @True@ if the client at the given client index is connected to
-- the server. Returns @False@ if not connected, if the server is not running,
-- or if the client index is out of bounds.
clientConnectedAtIndex :: Server -> Int -> IO Bool
clientConnectedAtIndex :: Server -> Int -> IO Bool
clientConnectedAtIndex (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO CInt -> IO Bool) -> (Int -> IO CInt) -> Int -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'netcode_server_t -> CInt -> IO CInt
c'netcode_server_client_connected Ptr C'netcode_server_t
s (CInt -> IO CInt) -> (Int -> CInt) -> Int -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Returns the client ID of the client at the given client index. Returns @0@
-- if not connected, the server is not running, or if the client index is out
-- of bounds.
clientIdAtIndex :: Server -> Int -> IO Word64
clientIdAtIndex :: Server -> Int -> IO Word64
clientIdAtIndex (Server Ptr C'netcode_server_t
s ServerCallbacks
_) = Ptr C'netcode_server_t -> CInt -> IO Word64
c'netcode_server_client_id Ptr C'netcode_server_t
s (CInt -> IO Word64) -> (Int -> CInt) -> Int -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Performs an action with the address of the client to which the given
-- 'Server' is connected to. This is meant to minimize the chances that the
-- 'Address' value will be used in a manner that outlives the given 'Server' or
-- the connection lifetime of the client. Callers should avoid storing the
-- 'Address' value or returning it as a result of this function.
--
-- In the event that the client index is out of bounds, or the client is not
-- connected at that slot, the address passed to the action will be @0.0.0.0@.
withClientAddressAtIndex :: Server -> Int -> (Address -> IO a) -> IO a
withClientAddressAtIndex :: Server -> Int -> (Address -> IO a) -> IO a
withClientAddressAtIndex (Server Ptr C'netcode_server_t
s ServerCallbacks
_) Int
cidx Address -> IO a
fn = do
    Ptr C'netcode_address_t
aptr <- Ptr C'netcode_server_t -> CInt -> IO (Ptr C'netcode_address_t)
c'netcode_server_client_address Ptr C'netcode_server_t
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cidx)
    if Ptr C'netcode_address_t
aptr Ptr C'netcode_address_t -> Ptr C'netcode_address_t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'netcode_address_t
forall a. Ptr a
nullPtr
        then String -> IO Address
parseAddress String
"0.0.0.0" IO Address -> (Address -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Address -> IO a
fn
        else ForeignPtr C'netcode_address_t -> Address
Address (ForeignPtr C'netcode_address_t -> Address)
-> IO (ForeignPtr C'netcode_address_t) -> IO Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'netcode_address_t -> IO (ForeignPtr C'netcode_address_t)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr C'netcode_address_t
aptr IO Address -> (Address -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Address -> IO a
fn

-- | Performs an action with the user data of the client to which the given
-- 'Server' is connected to. This is meant to minimize the chances that the
-- memory buffer will be used in a manner that outlives the given 'Server' or
-- the connection lifetime of the client. Callers should avoid storing the
-- @Ptr@ value or returning it as a result of this function.
--
-- In the event that the client index is out of bounds, or the client is not
-- connected at that slot, the given action will receive @nullPtr@.
withClientUserDataAtIndex :: Server -> Int -> (Ptr () -> IO a) -> IO a
withClientUserDataAtIndex :: Server -> Int -> (Ptr () -> IO a) -> IO a
withClientUserDataAtIndex (Server Ptr C'netcode_server_t
s ServerCallbacks
_) Int
cidx Ptr () -> IO a
fn =
    Ptr C'netcode_server_t -> CInt -> IO (Ptr ())
c'netcode_server_client_user_data Ptr C'netcode_server_t
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cidx) IO (Ptr ()) -> (Ptr () -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO a
fn

-- | Returns the user data for the client connected at the given client index.
--
-- In the event that the client index is out of bounds, or the client is not
-- connected at that slot, the result will be the empty list.
clientUserDataAtIndex :: Server -> Int -> IO [Word8]
clientUserDataAtIndex :: Server -> Int -> IO [Word8]
clientUserDataAtIndex Server
s Int
i = Server -> Int -> (Ptr () -> IO [Word8]) -> IO [Word8]
forall a. Server -> Int -> (Ptr () -> IO a) -> IO a
withClientUserDataAtIndex Server
s Int
i ((Ptr () -> IO [Word8]) -> IO [Word8])
-> (Ptr () -> IO [Word8]) -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
    if Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
        then [Word8] -> IO [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
forall a. Num a => a
c'NETCODE_USER_DATA_BYTES (Ptr () -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr)

-- | Returns the maximum number of clients that can connect to this server, or
-- zero if the server has not been started yet (via a call to 'startServer').
maxClientsForServer :: Server -> IO Int
maxClientsForServer :: Server -> IO Int
maxClientsForServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'netcode_server_t -> IO CInt
c'netcode_server_max_clients Ptr C'netcode_server_t
s

-- | Returns the number of currently connected clients.
numConnectedClients :: Server -> IO Int
numConnectedClients :: Server -> IO Int
numConnectedClients (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'netcode_server_t -> IO CInt
c'netcode_server_num_connected_clients Ptr C'netcode_server_t
s

-- | Returns True if the server has been started, and is ready to accept
-- incoming connections from clients.
isServerRunning :: Server -> IO Bool
isServerRunning :: Server -> IO Bool
isServerRunning (Server Ptr C'netcode_server_t
s ServerCallbacks
_) = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'netcode_server_t -> IO CInt
c'netcode_server_running Ptr C'netcode_server_t
s

-- | Returns true if the number of connected clients matches the maximum number
-- of possibly connected clients.
isServerFull :: Server -> IO Bool
isServerFull :: Server -> IO Bool
isServerFull (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    (CInt -> CInt -> Bool) -> IO CInt -> IO CInt -> IO Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Ptr C'netcode_server_t -> IO CInt
c'netcode_server_num_connected_clients Ptr C'netcode_server_t
s)
                (Ptr C'netcode_server_t -> IO CInt
c'netcode_server_max_clients Ptr C'netcode_server_t
s)

-- | Returns the port assigned to the server's IP address.
getServerPort :: Server -> IO Word16
getServerPort :: Server -> IO Word16
getServerPort (Server Ptr C'netcode_server_t
s ServerCallbacks
_) = Ptr C'netcode_server_t -> IO Word16
c'netcode_server_get_port Ptr C'netcode_server_t
s

-- | Disconnects the client at the given index from the server.
disconnectClientFromServer :: Server -> Int -> IO ()
disconnectClientFromServer :: Server -> Int -> IO ()
disconnectClientFromServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    Ptr C'netcode_server_t -> CInt -> IO ()
c'netcode_server_disconnect_client Ptr C'netcode_server_t
s (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

-- | Disconnects all clients from the server.
disconnectAllClientsFromServer :: Server -> IO ()
disconnectAllClientsFromServer :: Server -> IO ()
disconnectAllClientsFromServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    Ptr C'netcode_server_t -> IO ()
c'netcode_server_disconnect_all_clients Ptr C'netcode_server_t
s

-- | Returns the next sequence number of a packet destined for the client at
-- the given client index.
nextServerPacketSequence :: Server -> Int -> IO Word64
nextServerPacketSequence :: Server -> Int -> IO Word64
nextServerPacketSequence (Server Ptr C'netcode_server_t
s ServerCallbacks
_) =
    Ptr C'netcode_server_t -> CInt -> IO Word64
c'netcode_server_next_packet_sequence Ptr C'netcode_server_t
s (CInt -> IO Word64) -> (Int -> CInt) -> Int -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Enqueues a packet to be sent to the client at the given index during the
-- next call to 'updateServer'.
sendPacketFromServer :: Server
                     -> Int        -- ^ Client index
                     -> Int        -- ^ Size in bytes of packet data
                     -> Ptr Word8  -- ^ Packet data buffer
                     -> IO ()
sendPacketFromServer :: Server -> Int -> Int -> Ptr Word8 -> IO ()
sendPacketFromServer (Server Ptr C'netcode_server_t
s ServerCallbacks
_) Int
clientIdx Int
pktSz Ptr Word8
pktMem = do
    let pktSize :: CInt
pktSize = CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
min CInt
forall a. Num a => a
c'NETCODE_MAX_PACKET_SIZE (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pktSz)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pktSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Num a => a
c'NETCODE_MAX_PACKET_SIZE) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String
"WARNING: Sending packet that's too large: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
pktSz
    Ptr C'netcode_server_t -> CInt -> Ptr Word8 -> CInt -> IO ()
c'netcode_server_send_packet Ptr C'netcode_server_t
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
clientIdx) Ptr Word8
pktMem CInt
pktSize

-- | Enqueues a packet with the given size and data to all connected clients.
broadcastPacketFromServer :: Server -> Int -> Ptr Word8 -> IO ()
broadcastPacketFromServer :: Server -> Int -> Ptr Word8 -> IO ()
broadcastPacketFromServer Server
s Int
pktSz Ptr Word8
pktMem = do
    Int
numClients <- Server -> IO Int
numConnectedClients Server
s
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
numClients Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Server -> Int -> Int -> Ptr Word8 -> IO ()
sendPacketFromServer Server
s Int
i Int
pktSz Ptr Word8
pktMem

-- | Dequeues a received packet from the t'Netcode.IO.Client' at the given
-- client index. This function returns a @Just@ until the queue is empty, upon
-- which it will return a @Nothing@.
receivePacketFromClient :: Server -> Int -> IO (Maybe Packet)
receivePacketFromClient :: Server -> Int -> IO (Maybe Packet)
receivePacketFromClient (Server Ptr C'netcode_server_t
s ServerCallbacks
_) Int
clientIdx =
    (Ptr Word64 -> IO (Maybe Packet)) -> IO (Maybe Packet)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word64 -> IO (Maybe Packet)) -> IO (Maybe Packet))
-> (Ptr Word64 -> IO (Maybe Packet)) -> IO (Maybe Packet)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
sequenceNumPtr ->
    (Ptr CInt -> IO (Maybe Packet)) -> IO (Maybe Packet)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe Packet)) -> IO (Maybe Packet))
-> (Ptr CInt -> IO (Maybe Packet)) -> IO (Maybe Packet)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pktSzPtr -> do
        Ptr Word8
packetMem <- Ptr C'netcode_server_t
-> CInt -> Ptr CInt -> Ptr Word64 -> IO (Ptr Word8)
c'netcode_server_receive_packet Ptr C'netcode_server_t
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
clientIdx) Ptr CInt
pktSzPtr Ptr Word64
sequenceNumPtr
        if Ptr Word8
packetMem Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr
            then Maybe Packet -> IO (Maybe Packet)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Packet
forall a. Maybe a
Nothing
            else (Packet -> Maybe Packet) -> IO Packet -> IO (Maybe Packet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Maybe Packet
forall a. a -> Maybe a
Just (IO Packet -> IO (Maybe Packet)) -> IO Packet -> IO (Maybe Packet)
forall a b. (a -> b) -> a -> b
$
                Word64 -> Int -> ForeignPtr Word8 -> Packet
Packet (Word64 -> Int -> ForeignPtr Word8 -> Packet)
-> IO Word64 -> IO (Int -> ForeignPtr Word8 -> Packet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
sequenceNumPtr
                        IO (Int -> ForeignPtr Word8 -> Packet)
-> IO Int -> IO (ForeignPtr Word8 -> Packet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pktSzPtr)
                        IO (ForeignPtr Word8 -> Packet)
-> IO (ForeignPtr Word8) -> IO Packet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO () -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr Word8
packetMem (Ptr C'netcode_server_t -> Ptr () -> IO ()
c'netcode_server_free_packet Ptr C'netcode_server_t
s (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
packetMem))