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

{-# 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