wizard-wipeout/src-client/Client/Communication.hs

60 lines
1.3 KiB
Haskell
Raw Normal View History

2023-12-10 19:12:53 +00:00
{-# LANGUAGE LambdaCase #-}
module Client.Communication where
import qualified Control.Concurrent.STM as STM
2023-12-11 06:07:09 +00:00
import Control.Monad (void)
2023-12-10 19:12:53 +00:00
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.Maybe (fromJust)
2023-12-11 06:07:09 +00:00
import qualified Data.Vector.Storable as VS
2023-12-11 06:07:09 +00:00
import Foreign hiding (void)
import Network.Socket
2023-12-10 19:12:53 +00:00
-- internal imports
import Library.Types
connectSocket
:: FilePath
2023-12-10 19:12:53 +00:00
-> IO Socket
connectSocket path = do
sock <- socket AF_UNIX Stream defaultProtocol
setSocketOption sock KeepAlive 1
connect sock (SockAddrUnix path)
2023-12-10 19:12:53 +00:00
pure sock
-- | Sends a specified message through given socket to the server
sendMessage
2023-12-11 08:49:24 +00:00
:: ClientMessage
2023-12-10 19:12:53 +00:00
-> Socket
-> IO ()
sendMessage msg sock = do
let msgJson = A.encode msg
2023-12-11 06:07:09 +00:00
msgVector = VS.fromList $ B.unpack $ B.toStrict msgJson
VS.unsafeWith
msgVector
(\ptr -> void $ sendBuf sock ptr (VS.length msgVector))
2023-12-10 19:12:53 +00:00
receiveMessage
:: Socket
-> STM.TQueue ServerMessage
-> IO ()
receiveMessage sock queue = do
2023-12-11 06:07:09 +00:00
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
(pure ())
(STM.atomically . STM.writeTQueue queue)
2023-12-11 06:07:09 +00:00
mJsonMsg