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,33 +38,35 @@ receiveMessage sockContainer queue = do
   sock <- STM.atomically $ STM.readTMVar sockContainer
   let maxBufferLength = 4096
   putStrLn "read socket container for receiving"
-  mMsg <- do
+  ptr <- mallocArray maxBufferLength
-    ptr <- mallocArray maxBufferLength
+  putStrLn "receiving data"
-    putStrLn "receiving data"
+  eBufferLength <-
-    eBufferLength <-
+    try $ recvBuf sock ptr maxBufferLength
-      try $ recvBuf sock ptr maxBufferLength
+  putStrLn $ "received raw buffer length of: " <> show eBufferLength
-    putStrLn $ "received raw buffer length of: " <> show eBufferLength
+  bufferLength <- case eBufferLength of
-    free ptr
+    Left (e :: IOException) -> do
-    bufferLength <- case eBufferLength of
+      -- putStrLn ("Socket vanished, cleaning up after " <> show e)
-      Left (e :: IOException) -> do
+      -- dropClient clientList sock
-        -- putStrLn ("Socket vanished, cleaning up after " <> show e)
+      pure 0
-        -- dropClient clientList sock
+    Right len -> pure len
-        pure 0
+  putStrLn $ "received buffer of length: " <> show bufferLength
-      Right len -> pure len
+  rawMsg <- B.pack <$> peekArray bufferLength ptr
-    putStrLn $ "received buffer of length: " <> show bufferLength
+  free ptr
-    msg <- B.pack <$> peekArray bufferLength ptr
+  putStrLn $ "received data: " <> show rawMsg
-    putStrLn $ "received data: " <> show msg
+  let msgs =
-    if bufferLength > 0 && msg /= ""
+        if B.length rawMsg < 1
-    then do
+        then [] ::  [B8.ByteString]
-      putStrLn $ "received message: " <> show msg
+        else map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg
-      pure (A.decode' $ B8.fromStrict msg :: Maybe ClientMessage)
+  putStrLn $ "received messages: " <> show msgs
-    else
+  print msgs
-      pure Nothing
+  mapM_
-  maybe
-    (pure ())
     (\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
+        )
+        mJsonMsg
     )
-    mMsg
+    msgs