70 lines
1.8 KiB
Haskell
70 lines
1.8 KiB
Haskell
{-# 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.readTMVar sockContainer
|
|
let maxBufferLength = 4096
|
|
putStrLn "read 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
|