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

{-# LANGUAGE OverloadedStrings #-}
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
  -> IO ()
receiveMessage sockContainer queue = do
  randSleep <- randomRIO (1, 1000)
  threadDelay randSleep
  sock <- STM.atomically $ STM.takeTMVar sockContainer
  let maxBufferLength = 4096
  putStrLn "took socket container for receiving"
  mMsg <- do
    ptr <- mallocArray maxBufferLength
    putStrLn "receiving data"
    eBufferLength <-
      try $ recvBuf sock ptr maxBufferLength
    putStrLn $ "received raw buffer length of: " <> show eBufferLength
    free ptr
    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
    putStrLn $ "received buffer of length: " <> show bufferLength
    msg <- B.pack <$> peekArray bufferLength ptr
    putStrLn $ "received data: " <> show msg
    if bufferLength > 0 && msg /= ""
    then do
      putStrLn $ "received message: " <> show msg
      pure (A.decode' $ B8.fromStrict msg :: Maybe ClientMessage)
    else
      pure Nothing
  maybe
    (pure ())
    (\msg -> do
      print msg
      liftIO $ STM.atomically $ STM.writeTQueue queue msg
      -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
    )
    mMsg