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 import Network.Socket import Library.Types import Server.Communication.Send import Server.Types -- | receive a 'ClientMessage' receiveMessage :: Socket -> STM.TQueue ClientMessage -> STM.TMVar [ClientComms] -> IO () receiveMessage sock queue clientList = do let maxBufferLength = 4096 mMsg <- do ptr <- mallocArray maxBufferLength eBufferLength <- try $ recvBuf sock ptr maxBufferLength bufferLength <- case eBufferLength of Left (_ :: IOException) -> do putStrLn "Socket vanished, cleaning up…" 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