include some failsafes

configuration.yaml

@@ -2,4 +2,4 @@ setSocketPath         : "/tmp/wizard.sock"
 setMapRows            : 20
 setMapColumns         : 20
 setSpawnerProbability : 0.01
-setFPS                : 5
+setFPS                : 30

src-client/Client/Communication.hs

@@ -54,6 +54,6 @@ receiveMessage sock queue = do
   msg <- B.pack <$> peekArray bufferLength ptr
   let mJsonMsg = A.decode' $ B8.fromStrict msg
   maybe
-    (pure ())
+    (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
     (STM.atomically . STM.writeTQueue queue)
     mJsonMsg

src-client/Main.hs

@@ -5,6 +5,8 @@ import Control.Concurrent (threadDelay)
 
 import qualified Control.Concurrent.STM as STM
 
+import Control.Monad.Loops (whileM_)
+
 import Options.Applicative
 
 -- internal imports
@@ -22,24 +24,33 @@ main = do
   sock <- connectSocket socketLocation
   queue <- STM.newTQueueIO
   putStrLn "connected"
+
+
   sendMessage (IdRequest) sock
   threadDelay $ 1 * 10 ^ 6
   receiveMessage sock queue
-  threadDelay $ 1 * 10 ^ 6
+  whileM_
+    (STM.atomically $ STM.isEmptyTQueue queue)
+    (threadDelay $ 1 * 10 ^ 6)
   clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue)
   let clientId = acClientUUID clientIdMsg
   putStrLn $ "received client UUID: " <> show clientId
-  threadDelay $ 1 * 10 ^ 6
+
-  putStrLn welcomeText
+
-  threadDelay $ 15 * 10 ^ 6
   putStrLn welcomeText
+  -- threadDelay $ 15 * 10 ^ 6
+
+
   sendMessage (ClientMessage clientId ClientRequestWizard) sock
   threadDelay $ 1 * 10 ^ 6
   receiveMessage sock queue
-  threadDelay $ 1 * 10 ^ 6
+  whileM_
+    (STM.atomically $ STM.isEmptyTQueue queue)
+    (threadDelay $ 1 * 10 ^ 6)
   playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
-  putStrLn "received wizard"
+  putStrLn $ "received wizard: " <> show (initWizard playerWizard)
-  print (initWizard playerWizard)
+
+
   let initRead = ReaderContainer sock clientId
       initState = StateContainer (initWizard playerWizard)
   putStrLn "sending quit message"

src-lib/Library/Types/Communication.hs

@@ -10,6 +10,7 @@ import GHC.Generics
 -- internal imports
 
 import Library.Types.Player
+import Library.Types.Map
 
 data ServerMessage
   = ServerQuit

src-server/Server/Communication.hs

@@ -110,6 +110,7 @@ sendMessage
 sendMessage msg sock = do
   let msgJson = A.encode msg
       msgVector = VS.fromList $ B.unpack $ B.toStrict msgJson
+  putStrLn $ "sending: " <> B8.unpack msgJson
   VS.unsafeWith
     msgVector
     (\ptr -> void $ sendBuf sock ptr (VS.length msgVector))
@@ -125,7 +126,10 @@ processMessages = do
   mapM_
     (\(uuid, clientSocket) -> void $ liftIO $ forkIO $ do
       receiveMessage clientSocket queue
-      handleMessage serverState readerContainer
+      msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue
+      mapM_
+        (handleMessage serverState readerContainer)
+        msgs
     )
     clients
 
@@ -151,6 +155,7 @@ receiveMessage sock queue = do
     (pure ())
     (\msg -> do
       liftIO $ STM.atomically $ STM.writeTQueue queue msg
+      when (msg == IdRequest) (threadDelay $ 10 ^ 3)
     )
     mmsg
 
@@ -158,23 +163,17 @@ receiveMessage sock queue = do
 handleMessage
   :: StateContainer
   -> ReaderContainer
+  -> ClientMessage
   -> IO ()
-handleMessage stateContainer readerContainer = do
+handleMessage stateContainer readerContainer msg = do
-  let queue         = scMessageQueue stateContainer
+  let clientList = scClientSockets stateContainer
-      clientList = scClientSockets stateContainer
-  msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue
   clients <- liftIO $ STM.atomically $ STM.readTMVar clientList
-  mapM_
+  putStrLn $ "Handling following: " <> show msg
-    (\msg -> liftIO $ do
-        putStrLn "Handling following:"
-        print msg
   case msg of
     IdRequest                      -> do
       clientId <- nextRandom
       let clientIdx = findIndex (\a -> fst a == Nothing) clients
       let clientSock = snd $ clients !! fromJust clientIdx
-            sendMessage (AcceptClient clientId) clientSock
-            putStrLn $ "Accepted Client with UUID " <> show clientId
       let newClients = map
             (\old@(muuid, oldClientSock) ->
               if oldClientSock == clientSock && muuid == Nothing
@@ -185,6 +184,8 @@ handleMessage stateContainer readerContainer = do
             )
             clients
       void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
+      putStrLn $ "Accepted Client with UUID " <> show clientId
+      sendMessage (AcceptClient clientId) clientSock
     ClientMessage clientId payload ->
       case payload of
         ClientQuit -> do
@@ -198,8 +199,6 @@ handleMessage stateContainer readerContainer = do
           let clientSock = fromJust $ lookup (Just clientId) clients
           sendMessage (ProvideInitialWizard (newWizard initPos)) clientSock
         _          -> pure ()
-    )
-    msgs
 
 newWizard
   :: Position