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

{-# LANGUAGE LambdaCase #-}
module Client.Communication where

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 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
  :: ClientMessages
  -> 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
  -> IO ServerMessage
receiveMessage sock = 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
  jsonMsg <- maybe
    (error $ "unexpected message from Server: " <> show msg)
    pure
    mJsonMsg
  free ptr
  pure jsonMsg