netcode-io-0.0.1: examples/Client.hs

-- This example serves as a counterpart to the example program of the same name
-- in the C library.
module Main (main) where

import qualified Netcode.IO

import Control.Exception (try, throw, AsyncException(..))
import Control.Monad (forM_, when)
import Data.Word (Word64, Word8)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Array (peekArray, withArrayLen)
import System.Environment (getArgs)
import System.Exit (ExitCode(..), exitSuccess)

gProtocolID :: Word64
gProtocolID = 0x1122334455667788

gPrivateKey :: [Word8]
gPrivateKey =
    [ 0x60, 0x6a, 0xbe, 0x6e, 0xc9, 0x19, 0x10, 0xea
    , 0x9a, 0x65, 0x62, 0xf6, 0x6f, 0x2b, 0x30, 0xe4
    , 0x43, 0x71, 0xd6, 0x2c, 0xd1, 0x99, 0x27, 0x26
    , 0x6b, 0x3c, 0x60, 0xf4, 0xb7, 0x15, 0xab, 0xa1
    ]

gConnectTokenExpiry :: Int
gConnectTokenExpiry = 30

gConnectTokenTimeout :: Int
gConnectTokenTimeout = 5

main :: IO ()
main = do
    Netcode.IO.initialize

    Netcode.IO.logLevel Netcode.IO.LogLevel'Info

    putStrLn "[client]"
    let stateChangeCallback old new =
            putStrLn $ "Old state: " <> show old <> " new state: " <> show new
        clientConfig = Netcode.IO.setClientStateChangeCallback stateChangeCallback
                     $ Netcode.IO.defaultClientConfig
    client <- Netcode.IO.createClient "0.0.0.0" clientConfig 0.0

    args <- getArgs
    let serverAddr = case length args of
          1 -> head args
          _ -> "127.0.0.1:40000"

    -- This is expected to be performed on an HTTP server
    clientID <- Netcode.IO.generateClientID
    putStrLn $ "client id is " <> show clientID

    connectToken <- Netcode.IO.generateConnectToken [(serverAddr, serverAddr)]
                                                    gConnectTokenExpiry 
                                                    gConnectTokenTimeout
                                                    clientID
                                                    gProtocolID
                                                    gPrivateKey
                                                    []

    Netcode.IO.connectClient client connectToken

    let untilM :: IO Bool -> IO ()
        untilM cond = do
            tf <- cond
            if tf then return () else untilM cond

        catchUserInterrupt :: IO a -> IO a
        catchUserInterrupt prg = do
            interruptResult <- try prg
            case interruptResult of
                (Left UserInterrupt) -> putStrLn "\nshutting down" >> exitSuccess
                (Left e) -> throw e
                (Right x) -> return x

    quitResult <- try $ catchUserInterrupt $ forM_ [0.0, 0.016667 ..] $ \time -> do
        Netcode.IO.updateClient client time

        clientState <- Netcode.IO.getClientState client
        when (clientState == Netcode.IO.ClientState'Connected) $
            withArrayLen [0..(Netcode.IO.maximumPacketSize - 1)] $
            Netcode.IO.sendPacketFromClient client

        untilM $ do
            mpkt <- Netcode.IO.receivePacketFromServer client
            case mpkt of
                Nothing -> return True
                Just pkt -> do
                    withForeignPtr (Netcode.IO.packetDataPtr pkt) $ \pktMem -> do
                        pktData <- peekArray (Netcode.IO.packetSize pkt) pktMem
                        case (and $ zipWith (==) pktData [0,1..]) of
                            True -> return False
                            False -> fail "Received garbled packet!"
                    
        clientState' <- Netcode.IO.getClientState client
        when (any (== clientState') [ Netcode.IO.ClientState'ConnectTokenExpired
                                    , Netcode.IO.ClientState'InvalidConnectToken
                                    , Netcode.IO.ClientState'ConnectionTimedOut
                                    , Netcode.IO.ClientState'ConnectionResponseTimedOut
                                    , Netcode.IO.ClientState'ConnectionRequestTimedOut
                                    , Netcode.IO.ClientState'ConnectionDenied
                                    , Netcode.IO.ClientState'Disconnected
                                    ]) exitSuccess

        Netcode.IO.sleep 0.016667

    case quitResult of
        (Left ExitSuccess) -> return ()
        (Right _) -> fail "forM_ with infinite list terminated?"
        (Left e) -> fail $ show e

    Netcode.IO.destroyClient client
    Netcode.IO.terminate