wizard-wipeout/src-client/Client/Communication.hs
2023-12-12 11:52:25 +01:00

84 lines
2.1 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
module Client.Communication where
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.STM as STM
import Control.Monad.RWS
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.Vector.Storable as VS
import Foreign hiding (void)
import Network.Socket
import System.Posix.Signals
-- internal imports
import Library.Types
import Client.Types
connectSocket
:: FilePath
-> IO Socket
connectSocket path = do
sock <- socket AF_UNIX Stream defaultProtocol
setSocketOption sock KeepAlive 1
connect sock (SockAddrUnix path)
pure sock
-- | Sends a specified message through given socket to the server
sendMessage
:: ClientMessage
-> Socket
-> IO ()
sendMessage msg sock = do
let msgJson = A.encode msg
msgVector = VS.fromList $ B.unpack $ B.toStrict msgJson
VS.unsafeWith
msgVector
(\ptr -> void $ sendBuf sock ptr (VS.length msgVector))
receiveMessage
:: Socket
-> STM.TQueue ServerMessage
-> IO ()
receiveMessage sock queue = do
let maxBufferLength = 4096
ptr <- mallocArray maxBufferLength
bufferLength <- recvBuf sock ptr maxBufferLength
msg <- B.pack <$> peekArray bufferLength ptr
let mJsonMsg = A.decode' $ B8.fromStrict msg
maybe
(putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
(STM.atomically . STM.writeTQueue queue)
mJsonMsg
-- | Function that installs a handler on SIGINT to terminate game
terminateGameOnSigint
:: Game ()
terminateGameOnSigint = do
sock <- asks rcSocket
clientId <- asks rcClientUUID
clientState <- gets scClientState
void $ liftIO $ installHandler
keyboardSignal
(CatchOnce $ do
STM.atomically $ do
currentState <- STM.readTMVar clientState
void $ STM.swapTMVar clientState $ currentState { clientStop = True }
threadDelay (10 ^ 6)
sendMessage (ClientMessage clientId ClientQuit) sock
close sock
-- Raise SIGINT again so it does not get blocked
raiseSignal keyboardSignal
)
Nothing