wizard-wipeout/src-server/Server/Communication/Receive.hs

module Server.Communication.Receive where

import Control.Concurrent (threadDelay)

import qualified Control.Concurrent.STM as STM

import Control.Exception

import Control.Monad.IO.Class

import qualified Data.Aeson as A

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as B8

import Foreign.Marshal hiding (void)

import Network.Socket

import System.Random

-- internal imports

import Library.Types

import Server.Communication.Send
import Server.Types

-- | receive a 'ClientMessage'
receiveMessage
  :: STM.TMVar Socket
  -> STM.TQueue ClientMessage
  -> STM.TMVar [ClientComms]
  -> IO ()
receiveMessage sockContainer queue clientList = do
  randSleep <- randomRIO (1, 1000)
  threadDelay randSleep
  msock <- STM.atomically $ STM.tryTakeTMVar sockContainer
  let maxBufferLength = 4096
  maybe
    (pure ())
    (\sock -> do
      putStrLn "took socket container for receiving"
      mMsg <- do
        ptr <- mallocArray maxBufferLength
        eBufferLength <-
          try $ recvBuf sock ptr maxBufferLength
        bufferLength <- case eBufferLength of
          Left (e :: IOException) -> do
            -- putStrLn ("Socket vanished, cleaning up after " <> show e)
            -- dropClient clientList sock
            pure 0
          Right len -> pure len
        msg <- B.pack <$> peekArray bufferLength ptr
        let mJsonMsg = A.decode' $ B8.fromStrict msg :: Maybe ClientMessage
        free ptr
        if bufferLength > 0
        then
          pure mJsonMsg
        else
          pure Nothing
      maybe
        (pure ())
        (\msg -> do
          print msg
          liftIO $ STM.atomically $ STM.writeTQueue queue msg
          -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
        )
        mMsg
      STM.atomically $ STM.putTMVar sockContainer sock
    )
    msock