59 lines
1.3 KiB
Haskell
59 lines
1.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Client.Communication where
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
import Control.Monad (void)
|
|
|
|
import qualified Data.Aeson as A
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Lazy.Char8 as B8
|
|
|
|
import Data.Maybe (fromJust)
|
|
|
|
import qualified Data.Vector.Storable as VS
|
|
|
|
import Foreign hiding (void)
|
|
|
|
import Network.Socket
|
|
|
|
-- internal imports
|
|
|
|
import Library.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
|
|
(pure ())
|
|
(STM.atomically . STM.writeTQueue queue)
|
|
mJsonMsg
|