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