module Server.Communication.Receive where 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 -- 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 sock <- STM.atomically $ STM.readTMVar sockContainer let maxBufferLength = 4096 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 liftIO $ STM.atomically $ STM.writeTQueue queue msg -- when (msg == IdRequest) (threadDelay $ 10 ^ 3) ) mMsg