{-# 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 Graphics.Vty as Vty 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 currentState <- STM.atomically $ do currentState <- STM.readTMVar clientState void $ STM.swapTMVar clientState $ currentState { clientStop = True } pure currentState Vty.shutdown (clientVty currentState) sendMessage (ClientMessage clientId ClientQuit) sock close sock -- Raise SIGINT again so it does not get blocked raiseSignal keyboardSignal ) Nothing