fixed sommunication issues

src-client/Client/Communication.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE BangPatterns #-}
 module Client.Communication where
 
@@ -48,7 +47,7 @@ sendMessage
   -> IO ()
 sendMessage msg sock = do
   putStrLn $ "sending message: " <> show msg
-  let msgJson = A.encode msg
+  let msgJson = ('<' `B8.cons` A.encode msg) `B8.snoc` '>'
       msgList = B.unpack $ B.toStrict msgJson
   putStrLn $ "sending raw message buffer: " <> show msgList
   ptr <- newArray msgList

src-server/Server/Communication/Handler.hs

@@ -63,6 +63,9 @@ handleMessage stateContainer readerContainer msg = do
       case payload of
         ClientQuit -> do
           putStrLn $ "client has quit the game: " <> show clientId
+          currentPlayers <- STM.atomically $ STM.readTMVar (scPlayers stateContainer)
+          let newPlayers = filter (\p -> playerId p /= clientId) currentPlayers
+          void $ STM.atomically $ STM.swapTMVar (scPlayers stateContainer) newPlayers
           let client = find (\a -> csUUID a == Just clientId) socks
           dropClient socketList queueList (csSocket $ fromJust client)
         ClientRequestWizard -> do

src-server/Server/Communication/Receive.hs

@@ -38,13 +38,11 @@ receiveMessage sockContainer queue = do
   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)
@@ -52,19 +50,23 @@ receiveMessage sockContainer queue = do
       pure 0
     Right len -> pure len
   putStrLn $ "received buffer of length: " <> show bufferLength
-    msg <- B.pack <$> peekArray bufferLength ptr
+  rawMsg <- B.pack <$> peekArray bufferLength ptr
-    putStrLn $ "received data: " <> show msg
+  free ptr
-    if bufferLength > 0 && msg /= ""
+  putStrLn $ "received data: " <> show rawMsg
-    then do
+  let msgs =
-      putStrLn $ "received message: " <> show msg
+        if B.length rawMsg < 1
-      pure (A.decode' $ B8.fromStrict msg :: Maybe ClientMessage)
+        then [] ::  [B8.ByteString]
-    else
+        else map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg
-      pure Nothing
+  putStrLn $ "received messages: " <> show msgs
-  maybe
+  print msgs
-    (pure ())
+  mapM_
     (\msg -> do
-      print msg
+      let mJsonMsg = A.decode' msg
-      liftIO $ STM.atomically $ STM.writeTQueue queue msg
+      maybe
-      -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
+        (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict rawMsg))
+        (\jsonMsg -> do
+          STM.atomically $ STM.writeTQueue queue jsonMsg
         )
-    mMsg
+        mJsonMsg
+    )
+    msgs