72 lines
1.8 KiB
Haskell
72 lines
1.8 KiB
Haskell
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
|