{-# LINE 1 "Bindings/Netcode/IO.hsc" #-}
{-|
  Module      : Bindings.Netcode.IO
  Description : Low-level bindings to the netcode.io library.
  Copyright   : (c) Pavel Krajcevski, 2020
  License     : BSD-3
  Maintainer  : krajcevski@gmail.com
  Stability   : experimental
  Portability : Portable

  This module contains the low-level bindings that represent the direct
  interface between Haskell and the C library
  <https://github.com/networkprotocol/netcode.io netcode.io>.

  The bindings here are meant for advanced usage, as they are not particularly
  idiomatic Haskell, and largely represent the types that we get from the
  <https://hackage.haskell.org/package/bindings-DSL bindings-DSL> library. For
  high level bindings (recommended), please refer to the "Netcode.IO" module.
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE StandaloneDeriving #-}
--------------------------------------------------------------------------------




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

module Bindings.Netcode.IO where

import Data.Word              (Word8, Word16, Word64)
import Foreign.C.String       (CString)
import Foreign.C.Types        (CInt(..), CDouble(..))
import Foreign.Marshal.Array  (peekArray, pokeArray)
import Foreign.Ptr            (Ptr, FunPtr, plusPtr)
import Foreign.Storable       (Storable(..))
import Prelude                ( IO, Eq, Show, Num
                              , ($)
                              , div, undefined, return, take
                              )

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

c'NETCODE_CONNECT_TOKEN_BYTES = 2048
c'NETCODE_CONNECT_TOKEN_BYTES :: (Num a) => a

{-# LINE 46 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_KEY_BYTES = 32
c'NETCODE_KEY_BYTES :: (Num a) => a

{-# LINE 47 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_MAC_BYTES = 16
c'NETCODE_MAC_BYTES :: (Num a) => a

{-# LINE 48 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_USER_DATA_BYTES = 256
c'NETCODE_USER_DATA_BYTES :: (Num a) => a

{-# LINE 49 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_MAX_SERVERS_PER_CONNECT = 32
c'NETCODE_MAX_SERVERS_PER_CONNECT :: (Num a) => a

{-# LINE 50 "Bindings/Netcode/IO.hsc" #-}

c'NETCODE_CLIENT_STATE_CONNECT_TOKEN_EXPIRED = -6
c'NETCODE_CLIENT_STATE_CONNECT_TOKEN_EXPIRED :: (Num a) => a

{-# LINE 52 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_INVALID_CONNECT_TOKEN = -5
c'NETCODE_CLIENT_STATE_INVALID_CONNECT_TOKEN :: (Num a) => a

{-# LINE 53 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_CONNECTION_TIMED_OUT = -4
c'NETCODE_CLIENT_STATE_CONNECTION_TIMED_OUT :: (Num a) => a

{-# LINE 54 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_CONNECTION_RESPONSE_TIMED_OUT = -3
c'NETCODE_CLIENT_STATE_CONNECTION_RESPONSE_TIMED_OUT :: (Num a) => a

{-# LINE 55 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_CONNECTION_REQUEST_TIMED_OUT = -2
c'NETCODE_CLIENT_STATE_CONNECTION_REQUEST_TIMED_OUT :: (Num a) => a

{-# LINE 56 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_CONNECTION_DENIED = -1
c'NETCODE_CLIENT_STATE_CONNECTION_DENIED :: (Num a) => a

{-# LINE 57 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_DISCONNECTED = 0
c'NETCODE_CLIENT_STATE_DISCONNECTED :: (Num a) => a

{-# LINE 58 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_SENDING_CONNECTION_REQUEST = 1
c'NETCODE_CLIENT_STATE_SENDING_CONNECTION_REQUEST :: (Num a) => a

{-# LINE 59 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_SENDING_CONNECTION_RESPONSE = 2
c'NETCODE_CLIENT_STATE_SENDING_CONNECTION_RESPONSE :: (Num a) => a

{-# LINE 60 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_CLIENT_STATE_CONNECTED = 3
c'NETCODE_CLIENT_STATE_CONNECTED :: (Num a) => a

{-# LINE 61 "Bindings/Netcode/IO.hsc" #-}

c'NETCODE_MAX_CLIENTS = 256
c'NETCODE_MAX_CLIENTS :: (Num a) => a

{-# LINE 63 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_MAX_PACKET_SIZE = 1200
c'NETCODE_MAX_PACKET_SIZE :: (Num a) => a

{-# LINE 64 "Bindings/Netcode/IO.hsc" #-}

c'NETCODE_LOG_LEVEL_NONE = 0
c'NETCODE_LOG_LEVEL_NONE :: (Num a) => a

{-# LINE 66 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_LOG_LEVEL_ERROR = 1
c'NETCODE_LOG_LEVEL_ERROR :: (Num a) => a

{-# LINE 67 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_LOG_LEVEL_INFO = 2
c'NETCODE_LOG_LEVEL_INFO :: (Num a) => a

{-# LINE 68 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_LOG_LEVEL_DEBUG = 3
c'NETCODE_LOG_LEVEL_DEBUG :: (Num a) => a

{-# LINE 69 "Bindings/Netcode/IO.hsc" #-}

c'NETCODE_OK = 1
c'NETCODE_OK :: (Num a) => a

{-# LINE 71 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_ERROR = 0
c'NETCODE_ERROR :: (Num a) => a

{-# LINE 72 "Bindings/Netcode/IO.hsc" #-}

c'NETCODE_ADDRESS_NONE = 0
c'NETCODE_ADDRESS_NONE :: (Num a) => a

{-# LINE 74 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_ADDRESS_IPV4 = 1
c'NETCODE_ADDRESS_IPV4 :: (Num a) => a

{-# LINE 75 "Bindings/Netcode/IO.hsc" #-}
c'NETCODE_ADDRESS_IPV6 = 2
c'NETCODE_ADDRESS_IPV6 :: (Num a) => a

{-# LINE 76 "Bindings/Netcode/IO.hsc" #-}

foreign import ccall "netcode_init" c'netcode_init
  :: IO CInt
foreign import ccall "&netcode_init" p'netcode_init
  :: FunPtr (IO CInt)

{-# LINE 78 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_term" c'netcode_term
  :: IO ()
foreign import ccall "&netcode_term" p'netcode_term
  :: FunPtr (IO ())

{-# LINE 79 "Bindings/Netcode/IO.hsc" #-}


{-# LINE 81 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 82 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 83 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 84 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 85 "Bindings/Netcode/IO.hsc" #-}
data C'netcode_address_t = C'netcode_address_t{
  c'netcode_address_t'data'ipv4 :: [Word8],
  c'netcode_address_t'data'ipv6 :: [Word16],
  c'netcode_address_t'port :: Word16,
  c'netcode_address_t'type :: Word8
} deriving (Eq,Show)
p'netcode_address_t'data'ipv4 p = plusPtr p 0
p'netcode_address_t'data'ipv4 :: Ptr (C'netcode_address_t) -> Ptr (Word8)
p'netcode_address_t'data'ipv6 p = plusPtr p 0
p'netcode_address_t'data'ipv6 :: Ptr (C'netcode_address_t) -> Ptr (Word16)
p'netcode_address_t'port p = plusPtr p 16
p'netcode_address_t'port :: Ptr (C'netcode_address_t) -> Ptr (Word16)
p'netcode_address_t'type p = plusPtr p 18
p'netcode_address_t'type :: Ptr (C'netcode_address_t) -> Ptr (Word8)
instance Storable C'netcode_address_t where
  sizeOf _ = 20
  alignment _ = 2
  peek _p = do
    v0 <- let s0 = div 4 $ sizeOf $ (undefined :: Word8) in peekArray s0 (plusPtr _p 0)
    v1 <- let s1 = div 16 $ sizeOf $ (undefined :: Word16) in peekArray s1 (plusPtr _p 0)
    v2 <- peekByteOff _p 16
    v3 <- peekByteOff _p 18
    return $ C'netcode_address_t v0 v1 v2 v3
  poke _p (C'netcode_address_t v0 v1 v2 v3) = do
    let s0 = div 4 $ sizeOf $ (undefined :: Word8)
    pokeArray (plusPtr _p 0) (take s0 v0)
    let s1 = div 16 $ sizeOf $ (undefined :: Word16)
    pokeArray (plusPtr _p 0) (take s1 v1)
    pokeByteOff _p 16 v2
    pokeByteOff _p 18 v3
    return ()

{-# LINE 86 "Bindings/Netcode/IO.hsc" #-}

foreign import ccall "netcode_parse_address" c'netcode_parse_address
  :: CString -> Ptr C'netcode_address_t -> IO CInt
foreign import ccall "&netcode_parse_address" p'netcode_parse_address
  :: FunPtr (CString -> Ptr C'netcode_address_t -> IO CInt)

{-# LINE 88 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_address_to_string" c'netcode_address_to_string
  :: Ptr C'netcode_address_t -> CString -> IO CString
foreign import ccall "&netcode_address_to_string" p'netcode_address_to_string
  :: FunPtr (Ptr C'netcode_address_t -> CString -> IO CString)

{-# LINE 89 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_address_equal" c'netcode_address_equal
  :: Ptr C'netcode_address_t -> Ptr C'netcode_address_t -> IO CInt
foreign import ccall "&netcode_address_equal" p'netcode_address_equal
  :: FunPtr (Ptr C'netcode_address_t -> Ptr C'netcode_address_t -> IO CInt)

{-# LINE 90 "Bindings/Netcode/IO.hsc" #-}

data C'netcode_network_simulator_t = C'netcode_network_simulator_t

{-# LINE 92 "Bindings/Netcode/IO.hsc" #-}
data C'netcode_client_t = C'netcode_client_t

{-# LINE 93 "Bindings/Netcode/IO.hsc" #-}
data C'netcode_server_t = C'netcode_server_t

{-# LINE 94 "Bindings/Netcode/IO.hsc" #-}

type C'allocate_function_t = FunPtr (Ptr () -> Word64 -> IO (Ptr ()))
foreign import ccall "wrapper" mk'allocate_function_t
  :: (Ptr () -> Word64 -> IO (Ptr ())) -> IO C'allocate_function_t
foreign import ccall "dynamic" mK'allocate_function_t
  :: C'allocate_function_t -> (Ptr () -> Word64 -> IO (Ptr ()))

{-# LINE 96 "Bindings/Netcode/IO.hsc" #-}
type C'free_function_t = FunPtr (Ptr () -> Ptr () -> IO ())
foreign import ccall "wrapper" mk'free_function_t
  :: (Ptr () -> Ptr () -> IO ()) -> IO C'free_function_t
foreign import ccall "dynamic" mK'free_function_t
  :: C'free_function_t -> (Ptr () -> Ptr () -> IO ())

{-# LINE 97 "Bindings/Netcode/IO.hsc" #-}
type C'state_change_callback_t = FunPtr (Ptr () -> CInt -> CInt -> IO ())
foreign import ccall "wrapper" mk'state_change_callback_t
  :: (Ptr () -> CInt -> CInt -> IO ()) -> IO C'state_change_callback_t
foreign import ccall "dynamic" mK'state_change_callback_t
  :: C'state_change_callback_t -> (Ptr () -> CInt -> CInt -> IO ())

{-# LINE 98 "Bindings/Netcode/IO.hsc" #-}
type C'connect_disconnect_callback_t = FunPtr (Ptr () -> CInt -> CInt -> IO ())
foreign import ccall "wrapper" mk'connect_disconnect_callback_t
  :: (Ptr () -> CInt -> CInt -> IO ()) -> IO C'connect_disconnect_callback_t
foreign import ccall "dynamic" mK'connect_disconnect_callback_t
  :: C'connect_disconnect_callback_t -> (Ptr () -> CInt -> CInt -> IO ())

{-# LINE 99 "Bindings/Netcode/IO.hsc" #-}
type C'send_loopback_packet_callback_t = FunPtr (Ptr () -> CInt -> Ptr Word8 -> CInt -> Word64 -> IO ())
foreign import ccall "wrapper" mk'send_loopback_packet_callback_t
  :: (Ptr () -> CInt -> Ptr Word8 -> CInt -> Word64 -> IO ()) -> IO C'send_loopback_packet_callback_t
foreign import ccall "dynamic" mK'send_loopback_packet_callback_t
  :: C'send_loopback_packet_callback_t -> (Ptr () -> CInt -> Ptr Word8 -> CInt -> Word64 -> IO ())

{-# LINE 100 "Bindings/Netcode/IO.hsc" #-}
type C'send_packet_override_t = FunPtr (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ())
foreign import ccall "wrapper" mk'send_packet_override_t
  :: (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ()) -> IO C'send_packet_override_t
foreign import ccall "dynamic" mK'send_packet_override_t
  :: C'send_packet_override_t -> (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ())

{-# LINE 101 "Bindings/Netcode/IO.hsc" #-}
type C'receive_packet_override_t = FunPtr (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO CInt)
foreign import ccall "wrapper" mk'receive_packet_override_t
  :: (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO CInt) -> IO C'receive_packet_override_t
foreign import ccall "dynamic" mK'receive_packet_override_t
  :: C'receive_packet_override_t -> (Ptr () -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO CInt)

{-# LINE 102 "Bindings/Netcode/IO.hsc" #-}


{-# LINE 104 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 105 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 106 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 107 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 108 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 109 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 110 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 111 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 112 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 113 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 114 "Bindings/Netcode/IO.hsc" #-}
data C'netcode_client_config_t = C'netcode_client_config_t{
  c'netcode_client_config_t'allocator_context :: Ptr (),
  c'netcode_client_config_t'allocate_function :: C'allocate_function_t,
  c'netcode_client_config_t'free_function :: C'free_function_t,
  c'netcode_client_config_t'network_simulator :: Ptr C'netcode_network_simulator_t,
  c'netcode_client_config_t'callback_context :: Ptr (),
  c'netcode_client_config_t'state_change_callback :: C'state_change_callback_t,
  c'netcode_client_config_t'send_loopback_packet_callback :: C'send_loopback_packet_callback_t,
  c'netcode_client_config_t'override_send_and_receive :: CInt,
  c'netcode_client_config_t'send_packet_override :: C'send_packet_override_t,
  c'netcode_client_config_t'receive_packet_override :: C'receive_packet_override_t
} deriving (Eq,Show)
p'netcode_client_config_t'allocator_context p = plusPtr p 0
p'netcode_client_config_t'allocator_context :: Ptr (C'netcode_client_config_t) -> Ptr (Ptr ())
p'netcode_client_config_t'allocate_function p = plusPtr p 8
p'netcode_client_config_t'allocate_function :: Ptr (C'netcode_client_config_t) -> Ptr (C'allocate_function_t)
p'netcode_client_config_t'free_function p = plusPtr p 16
p'netcode_client_config_t'free_function :: Ptr (C'netcode_client_config_t) -> Ptr (C'free_function_t)
p'netcode_client_config_t'network_simulator p = plusPtr p 24
p'netcode_client_config_t'network_simulator :: Ptr (C'netcode_client_config_t) -> Ptr (Ptr C'netcode_network_simulator_t)
p'netcode_client_config_t'callback_context p = plusPtr p 32
p'netcode_client_config_t'callback_context :: Ptr (C'netcode_client_config_t) -> Ptr (Ptr ())
p'netcode_client_config_t'state_change_callback p = plusPtr p 40
p'netcode_client_config_t'state_change_callback :: Ptr (C'netcode_client_config_t) -> Ptr (C'state_change_callback_t)
p'netcode_client_config_t'send_loopback_packet_callback p = plusPtr p 48
p'netcode_client_config_t'send_loopback_packet_callback :: Ptr (C'netcode_client_config_t) -> Ptr (C'send_loopback_packet_callback_t)
p'netcode_client_config_t'override_send_and_receive p = plusPtr p 56
p'netcode_client_config_t'override_send_and_receive :: Ptr (C'netcode_client_config_t) -> Ptr (CInt)
p'netcode_client_config_t'send_packet_override p = plusPtr p 64
p'netcode_client_config_t'send_packet_override :: Ptr (C'netcode_client_config_t) -> Ptr (C'send_packet_override_t)
p'netcode_client_config_t'receive_packet_override p = plusPtr p 72
p'netcode_client_config_t'receive_packet_override :: Ptr (C'netcode_client_config_t) -> Ptr (C'receive_packet_override_t)
instance Storable C'netcode_client_config_t where
  sizeOf _ = 80
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 16
    v3 <- peekByteOff _p 24
    v4 <- peekByteOff _p 32
    v5 <- peekByteOff _p 40
    v6 <- peekByteOff _p 48
    v7 <- peekByteOff _p 56
    v8 <- peekByteOff _p 64
    v9 <- peekByteOff _p 72
    return $ C'netcode_client_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9
  poke _p (C'netcode_client_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    pokeByteOff _p 16 v2
    pokeByteOff _p 24 v3
    pokeByteOff _p 32 v4
    pokeByteOff _p 40 v5
    pokeByteOff _p 48 v6
    pokeByteOff _p 56 v7
    pokeByteOff _p 64 v8
    pokeByteOff _p 72 v9
    return ()

{-# LINE 115 "Bindings/Netcode/IO.hsc" #-}

foreign import ccall "netcode_default_client_config" c'netcode_default_client_config
  :: Ptr C'netcode_client_config_t -> IO ()
foreign import ccall "&netcode_default_client_config" p'netcode_default_client_config
  :: FunPtr (Ptr C'netcode_client_config_t -> IO ())

{-# LINE 117 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_create" c'netcode_client_create
  :: CString -> Ptr C'netcode_client_config_t -> CDouble -> IO (Ptr C'netcode_client_t)
foreign import ccall "&netcode_client_create" p'netcode_client_create
  :: FunPtr (CString -> Ptr C'netcode_client_config_t -> CDouble -> IO (Ptr C'netcode_client_t))

{-# LINE 118 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_destroy" c'netcode_client_destroy
  :: Ptr C'netcode_client_t -> IO ()
foreign import ccall "&netcode_client_destroy" p'netcode_client_destroy
  :: FunPtr (Ptr C'netcode_client_t -> IO ())

{-# LINE 119 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_connect" c'netcode_client_connect
  :: Ptr C'netcode_client_t -> Ptr Word8 -> IO ()
foreign import ccall "&netcode_client_connect" p'netcode_client_connect
  :: FunPtr (Ptr C'netcode_client_t -> Ptr Word8 -> IO ())

{-# LINE 120 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_update" c'netcode_client_update
  :: Ptr C'netcode_client_t -> CDouble -> IO ()
foreign import ccall "&netcode_client_update" p'netcode_client_update
  :: FunPtr (Ptr C'netcode_client_t -> CDouble -> IO ())

{-# LINE 121 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_next_packet_sequence" c'netcode_client_next_packet_sequence
  :: Ptr C'netcode_client_t -> IO Word64
foreign import ccall "&netcode_client_next_packet_sequence" p'netcode_client_next_packet_sequence
  :: FunPtr (Ptr C'netcode_client_t -> IO Word64)

{-# LINE 122 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_send_packet" c'netcode_client_send_packet
  :: Ptr C'netcode_client_t -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&netcode_client_send_packet" p'netcode_client_send_packet
  :: FunPtr (Ptr C'netcode_client_t -> Ptr Word8 -> CInt -> IO ())

{-# LINE 123 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_receive_packet" c'netcode_client_receive_packet
  :: Ptr C'netcode_client_t -> Ptr CInt -> Ptr Word64 -> IO (Ptr Word8)
foreign import ccall "&netcode_client_receive_packet" p'netcode_client_receive_packet
  :: FunPtr (Ptr C'netcode_client_t -> Ptr CInt -> Ptr Word64 -> IO (Ptr Word8))

{-# LINE 124 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_free_packet" c'netcode_client_free_packet
  :: Ptr C'netcode_client_t -> Ptr () -> IO ()
foreign import ccall "&netcode_client_free_packet" p'netcode_client_free_packet
  :: FunPtr (Ptr C'netcode_client_t -> Ptr () -> IO ())

{-# LINE 125 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_disconnect" c'netcode_client_disconnect
  :: Ptr C'netcode_client_t -> IO ()
foreign import ccall "&netcode_client_disconnect" p'netcode_client_disconnect
  :: FunPtr (Ptr C'netcode_client_t -> IO ())

{-# LINE 126 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_state" c'netcode_client_state
  :: Ptr C'netcode_client_t -> IO CInt
foreign import ccall "&netcode_client_state" p'netcode_client_state
  :: FunPtr (Ptr C'netcode_client_t -> IO CInt)

{-# LINE 127 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_index" c'netcode_client_index
  :: Ptr C'netcode_client_t -> IO CInt
foreign import ccall "&netcode_client_index" p'netcode_client_index
  :: FunPtr (Ptr C'netcode_client_t -> IO CInt)

{-# LINE 128 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_max_clients" c'netcode_client_max_clients
  :: Ptr C'netcode_client_t -> IO CInt
foreign import ccall "&netcode_client_max_clients" p'netcode_client_max_clients
  :: FunPtr (Ptr C'netcode_client_t -> IO CInt)

{-# LINE 129 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_connect_loopback" c'netcode_client_connect_loopback
  :: Ptr C'netcode_client_t -> CInt -> CInt -> IO ()
foreign import ccall "&netcode_client_connect_loopback" p'netcode_client_connect_loopback
  :: FunPtr (Ptr C'netcode_client_t -> CInt -> CInt -> IO ())

{-# LINE 130 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_disconnect_loopback" c'netcode_client_disconnect_loopback
  :: Ptr C'netcode_client_t -> IO ()
foreign import ccall "&netcode_client_disconnect_loopback" p'netcode_client_disconnect_loopback
  :: FunPtr (Ptr C'netcode_client_t -> IO ())

{-# LINE 131 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_process_packet" c'netcode_client_process_packet
  :: Ptr C'netcode_client_t -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&netcode_client_process_packet" p'netcode_client_process_packet
  :: FunPtr (Ptr C'netcode_client_t -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ())

{-# LINE 132 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_loopback" c'netcode_client_loopback
  :: Ptr C'netcode_client_t -> IO CInt
foreign import ccall "&netcode_client_loopback" p'netcode_client_loopback
  :: FunPtr (Ptr C'netcode_client_t -> IO CInt)

{-# LINE 133 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_process_loopback_packet" c'netcode_client_process_loopback_packet
  :: Ptr C'netcode_client_t -> Ptr Word8 -> CInt -> Word64 -> IO ()
foreign import ccall "&netcode_client_process_loopback_packet" p'netcode_client_process_loopback_packet
  :: FunPtr (Ptr C'netcode_client_t -> Ptr Word8 -> CInt -> Word64 -> IO ())

{-# LINE 134 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_get_port" c'netcode_client_get_port
  :: Ptr C'netcode_client_t -> IO Word16
foreign import ccall "&netcode_client_get_port" p'netcode_client_get_port
  :: FunPtr (Ptr C'netcode_client_t -> IO Word16)

{-# LINE 135 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_client_server_address" c'netcode_client_server_address
  :: Ptr C'netcode_client_t -> IO (Ptr C'netcode_address_t)
foreign import ccall "&netcode_client_server_address" p'netcode_client_server_address
  :: FunPtr (Ptr C'netcode_client_t -> IO (Ptr C'netcode_address_t))

{-# LINE 136 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_generate_connect_token" c'netcode_generate_connect_token
  :: CInt -> Ptr CString -> Ptr CString -> CInt -> CInt -> Word64 -> Word64 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt
foreign import ccall "&netcode_generate_connect_token" p'netcode_generate_connect_token
  :: FunPtr (CInt -> Ptr CString -> Ptr CString -> CInt -> CInt -> Word64 -> Word64 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt)

{-# LINE 137 "Bindings/Netcode/IO.hsc" #-}


{-# LINE 139 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 140 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 141 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 142 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 143 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 144 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 145 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 146 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 147 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 148 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 149 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 150 "Bindings/Netcode/IO.hsc" #-}

{-# LINE 151 "Bindings/Netcode/IO.hsc" #-}
data C'netcode_server_config_t = C'netcode_server_config_t{
  c'netcode_server_config_t'protocol_id :: Word64,
  c'netcode_server_config_t'private_key :: [Word8],
  c'netcode_server_config_t'allocator_context :: Ptr (),
  c'netcode_server_config_t'allocate_function :: C'allocate_function_t,
  c'netcode_server_config_t'free_function :: C'free_function_t,
  c'netcode_server_config_t'network_simulator :: Ptr C'netcode_network_simulator_t,
  c'netcode_server_config_t'callback_context :: Ptr (),
  c'netcode_server_config_t'connect_disconnect_callback :: C'connect_disconnect_callback_t,
  c'netcode_server_config_t'send_loopback_packet_callback :: C'send_loopback_packet_callback_t,
  c'netcode_server_config_t'override_send_and_receive :: CInt,
  c'netcode_server_config_t'send_packet_override :: C'send_packet_override_t,
  c'netcode_server_config_t'receive_packet_override :: C'receive_packet_override_t
} deriving (Eq,Show)
p'netcode_server_config_t'protocol_id p = plusPtr p 0
p'netcode_server_config_t'protocol_id :: Ptr (C'netcode_server_config_t) -> Ptr (Word64)
p'netcode_server_config_t'private_key p = plusPtr p 8
p'netcode_server_config_t'private_key :: Ptr (C'netcode_server_config_t) -> Ptr (Word8)
p'netcode_server_config_t'allocator_context p = plusPtr p 40
p'netcode_server_config_t'allocator_context :: Ptr (C'netcode_server_config_t) -> Ptr (Ptr ())
p'netcode_server_config_t'allocate_function p = plusPtr p 48
p'netcode_server_config_t'allocate_function :: Ptr (C'netcode_server_config_t) -> Ptr (C'allocate_function_t)
p'netcode_server_config_t'free_function p = plusPtr p 56
p'netcode_server_config_t'free_function :: Ptr (C'netcode_server_config_t) -> Ptr (C'free_function_t)
p'netcode_server_config_t'network_simulator p = plusPtr p 64
p'netcode_server_config_t'network_simulator :: Ptr (C'netcode_server_config_t) -> Ptr (Ptr C'netcode_network_simulator_t)
p'netcode_server_config_t'callback_context p = plusPtr p 72
p'netcode_server_config_t'callback_context :: Ptr (C'netcode_server_config_t) -> Ptr (Ptr ())
p'netcode_server_config_t'connect_disconnect_callback p = plusPtr p 80
p'netcode_server_config_t'connect_disconnect_callback :: Ptr (C'netcode_server_config_t) -> Ptr (C'connect_disconnect_callback_t)
p'netcode_server_config_t'send_loopback_packet_callback p = plusPtr p 88
p'netcode_server_config_t'send_loopback_packet_callback :: Ptr (C'netcode_server_config_t) -> Ptr (C'send_loopback_packet_callback_t)
p'netcode_server_config_t'override_send_and_receive p = plusPtr p 96
p'netcode_server_config_t'override_send_and_receive :: Ptr (C'netcode_server_config_t) -> Ptr (CInt)
p'netcode_server_config_t'send_packet_override p = plusPtr p 104
p'netcode_server_config_t'send_packet_override :: Ptr (C'netcode_server_config_t) -> Ptr (C'send_packet_override_t)
p'netcode_server_config_t'receive_packet_override p = plusPtr p 112
p'netcode_server_config_t'receive_packet_override :: Ptr (C'netcode_server_config_t) -> Ptr (C'receive_packet_override_t)
instance Storable C'netcode_server_config_t where
  sizeOf _ = 120
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- let s1 = div 32 $ sizeOf $ (undefined :: Word8) in peekArray s1 (plusPtr _p 8)
    v2 <- peekByteOff _p 40
    v3 <- peekByteOff _p 48
    v4 <- peekByteOff _p 56
    v5 <- peekByteOff _p 64
    v6 <- peekByteOff _p 72
    v7 <- peekByteOff _p 80
    v8 <- peekByteOff _p 88
    v9 <- peekByteOff _p 96
    v10 <- peekByteOff _p 104
    v11 <- peekByteOff _p 112
    return $ C'netcode_server_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11
  poke _p (C'netcode_server_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11) = do
    pokeByteOff _p 0 v0
    let s1 = div 32 $ sizeOf $ (undefined :: Word8)
    pokeArray (plusPtr _p 8) (take s1 v1)
    pokeByteOff _p 40 v2
    pokeByteOff _p 48 v3
    pokeByteOff _p 56 v4
    pokeByteOff _p 64 v5
    pokeByteOff _p 72 v6
    pokeByteOff _p 80 v7
    pokeByteOff _p 88 v8
    pokeByteOff _p 96 v9
    pokeByteOff _p 104 v10
    pokeByteOff _p 112 v11
    return ()

{-# LINE 152 "Bindings/Netcode/IO.hsc" #-}

foreign import ccall "netcode_default_server_config" c'netcode_default_server_config
  :: Ptr C'netcode_server_config_t -> IO ()
foreign import ccall "&netcode_default_server_config" p'netcode_default_server_config
  :: FunPtr (Ptr C'netcode_server_config_t -> IO ())

{-# LINE 154 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_create" c'netcode_server_create
  :: CString -> Ptr C'netcode_server_config_t -> CDouble -> IO (Ptr C'netcode_server_t)
foreign import ccall "&netcode_server_create" p'netcode_server_create
  :: FunPtr (CString -> Ptr C'netcode_server_config_t -> CDouble -> IO (Ptr C'netcode_server_t))

{-# LINE 155 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_destroy" c'netcode_server_destroy
  :: Ptr C'netcode_server_t -> IO ()
foreign import ccall "&netcode_server_destroy" p'netcode_server_destroy
  :: FunPtr (Ptr C'netcode_server_t -> IO ())

{-# LINE 156 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_start" c'netcode_server_start
  :: Ptr C'netcode_server_t -> CInt -> IO ()
foreign import ccall "&netcode_server_start" p'netcode_server_start
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO ())

{-# LINE 157 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_stop" c'netcode_server_stop
  :: Ptr C'netcode_server_t -> IO ()
foreign import ccall "&netcode_server_stop" p'netcode_server_stop
  :: FunPtr (Ptr C'netcode_server_t -> IO ())

{-# LINE 158 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_running" c'netcode_server_running
  :: Ptr C'netcode_server_t -> IO CInt
foreign import ccall "&netcode_server_running" p'netcode_server_running
  :: FunPtr (Ptr C'netcode_server_t -> IO CInt)

{-# LINE 159 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_max_clients" c'netcode_server_max_clients
  :: Ptr C'netcode_server_t -> IO CInt
foreign import ccall "&netcode_server_max_clients" p'netcode_server_max_clients
  :: FunPtr (Ptr C'netcode_server_t -> IO CInt)

{-# LINE 160 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_update" c'netcode_server_update
  :: Ptr C'netcode_server_t -> CDouble -> IO ()
foreign import ccall "&netcode_server_update" p'netcode_server_update
  :: FunPtr (Ptr C'netcode_server_t -> CDouble -> IO ())

{-# LINE 161 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_client_connected" c'netcode_server_client_connected
  :: Ptr C'netcode_server_t -> CInt -> IO CInt
foreign import ccall "&netcode_server_client_connected" p'netcode_server_client_connected
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO CInt)

{-# LINE 162 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_client_id" c'netcode_server_client_id
  :: Ptr C'netcode_server_t -> CInt -> IO Word64
foreign import ccall "&netcode_server_client_id" p'netcode_server_client_id
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO Word64)

{-# LINE 163 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_client_address" c'netcode_server_client_address
  :: Ptr C'netcode_server_t -> CInt -> IO (Ptr C'netcode_address_t)
foreign import ccall "&netcode_server_client_address" p'netcode_server_client_address
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO (Ptr C'netcode_address_t))

{-# LINE 164 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_disconnect_client" c'netcode_server_disconnect_client
  :: Ptr C'netcode_server_t -> CInt -> IO ()
foreign import ccall "&netcode_server_disconnect_client" p'netcode_server_disconnect_client
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO ())

{-# LINE 165 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_disconnect_all_clients" c'netcode_server_disconnect_all_clients
  :: Ptr C'netcode_server_t -> IO ()
foreign import ccall "&netcode_server_disconnect_all_clients" p'netcode_server_disconnect_all_clients
  :: FunPtr (Ptr C'netcode_server_t -> IO ())

{-# LINE 166 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_next_packet_sequence" c'netcode_server_next_packet_sequence
  :: Ptr C'netcode_server_t -> CInt -> IO Word64
foreign import ccall "&netcode_server_next_packet_sequence" p'netcode_server_next_packet_sequence
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO Word64)

{-# LINE 167 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_send_packet" c'netcode_server_send_packet
  :: Ptr C'netcode_server_t -> CInt -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&netcode_server_send_packet" p'netcode_server_send_packet
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> Ptr Word8 -> CInt -> IO ())

{-# LINE 168 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_receive_packet" c'netcode_server_receive_packet
  :: Ptr C'netcode_server_t -> CInt -> Ptr CInt -> Ptr Word64 -> IO (Ptr Word8)
foreign import ccall "&netcode_server_receive_packet" p'netcode_server_receive_packet
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> Ptr CInt -> Ptr Word64 -> IO (Ptr Word8))

{-# LINE 169 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_free_packet" c'netcode_server_free_packet
  :: Ptr C'netcode_server_t -> Ptr () -> IO ()
foreign import ccall "&netcode_server_free_packet" p'netcode_server_free_packet
  :: FunPtr (Ptr C'netcode_server_t -> Ptr () -> IO ())

{-# LINE 170 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_num_connected_clients" c'netcode_server_num_connected_clients
  :: Ptr C'netcode_server_t -> IO CInt
foreign import ccall "&netcode_server_num_connected_clients" p'netcode_server_num_connected_clients
  :: FunPtr (Ptr C'netcode_server_t -> IO CInt)

{-# LINE 171 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_client_user_data" c'netcode_server_client_user_data
  :: Ptr C'netcode_server_t -> CInt -> IO (Ptr ())
foreign import ccall "&netcode_server_client_user_data" p'netcode_server_client_user_data
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO (Ptr ()))

{-# LINE 172 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_process_packet" c'netcode_server_process_packet
  :: Ptr C'netcode_server_t -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&netcode_server_process_packet" p'netcode_server_process_packet
  :: FunPtr (Ptr C'netcode_server_t -> Ptr C'netcode_address_t -> Ptr Word8 -> CInt -> IO ())

{-# LINE 173 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_connect_loopback_client" c'netcode_server_connect_loopback_client
  :: Ptr C'netcode_server_t -> CInt -> Word64 -> Ptr Word8 -> IO ()
foreign import ccall "&netcode_server_connect_loopback_client" p'netcode_server_connect_loopback_client
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> Word64 -> Ptr Word8 -> IO ())

{-# LINE 174 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_disconnect_loopback_client" c'netcode_server_disconnect_loopback_client
  :: Ptr C'netcode_server_t -> CInt -> IO ()
foreign import ccall "&netcode_server_disconnect_loopback_client" p'netcode_server_disconnect_loopback_client
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO ())

{-# LINE 175 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_client_loopback" c'netcode_server_client_loopback
  :: Ptr C'netcode_server_t -> CInt -> IO CInt
foreign import ccall "&netcode_server_client_loopback" p'netcode_server_client_loopback
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> IO CInt)

{-# LINE 176 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_process_loopback_packet" c'netcode_server_process_loopback_packet
  :: Ptr C'netcode_server_t -> CInt -> Ptr Word8 -> CInt -> Word64 -> IO ()
foreign import ccall "&netcode_server_process_loopback_packet" p'netcode_server_process_loopback_packet
  :: FunPtr (Ptr C'netcode_server_t -> CInt -> Ptr Word8 -> CInt -> Word64 -> IO ())

{-# LINE 177 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_server_get_port" c'netcode_server_get_port
  :: Ptr C'netcode_server_t -> IO Word16
foreign import ccall "&netcode_server_get_port" p'netcode_server_get_port
  :: FunPtr (Ptr C'netcode_server_t -> IO Word16)

{-# LINE 178 "Bindings/Netcode/IO.hsc" #-}

foreign import ccall "netcode_log_level" c'netcode_log_level
  :: CInt -> IO ()
foreign import ccall "&netcode_log_level" p'netcode_log_level
  :: FunPtr (CInt -> IO ())

{-# LINE 180 "Bindings/Netcode/IO.hsc" #-}

type C'netcode_assert_function_ty = FunPtr (CString -> CString -> CString -> CInt -> IO ())
foreign import ccall "wrapper" mk'netcode_assert_function_ty
  :: (CString -> CString -> CString -> CInt -> IO ()) -> IO C'netcode_assert_function_ty
foreign import ccall "dynamic" mK'netcode_assert_function_ty
  :: C'netcode_assert_function_ty -> (CString -> CString -> CString -> CInt -> IO ())

{-# LINE 182 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_set_assert_function" c'netcode_set_assert_function
  :: C'netcode_assert_function_ty -> IO ()
foreign import ccall "&netcode_set_assert_function" p'netcode_set_assert_function
  :: FunPtr (C'netcode_assert_function_ty -> IO ())

{-# LINE 183 "Bindings/Netcode/IO.hsc" #-}

-- void netcode_set_printf_function( int (*function)( NETCODE_CONST char *, ... ) );

foreign import ccall "netcode_random_bytes" c'netcode_random_bytes
  :: Ptr Word8 -> CInt -> IO ()
foreign import ccall "&netcode_random_bytes" p'netcode_random_bytes
  :: FunPtr (Ptr Word8 -> CInt -> IO ())

{-# LINE 187 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_sleep" c'netcode_sleep
  :: CDouble -> IO ()
foreign import ccall "&netcode_sleep" p'netcode_sleep
  :: FunPtr (CDouble -> IO ())

{-# LINE 188 "Bindings/Netcode/IO.hsc" #-}
foreign import ccall "netcode_time" c'netcode_time
  :: IO CDouble
foreign import ccall "&netcode_time" p'netcode_time
  :: FunPtr (IO CDouble)

{-# LINE 189 "Bindings/Netcode/IO.hsc" #-}

-- | For testing only.
foreign import ccall "netcode_test" c'netcode_test
  :: IO ()
foreign import ccall "&netcode_test" p'netcode_test
  :: FunPtr (IO ())

{-# LINE 192 "Bindings/Netcode/IO.hsc" #-}