remove client deadlocks

src-client/Main.hs

@@ -22,31 +22,29 @@ main = do
   (Options socketLocation) <- execParser opts
   putStrLn $ "connecting to Socket " <> socketLocation
   sock <- connectSocket socketLocation
-  queue <- STM.newTQueueIO
   putStrLn "connected"
 
 
+  queue <- STM.newTQueueIO
+
+
   sendMessage (IdRequest) sock
   threadDelay $ 1 * 10 ^ 6
   receiveMessage sock queue
-  whileM_
-    (STM.atomically $ STM.isEmptyTQueue queue)
-    (threadDelay $ 1 * 10 ^ 6)
+  awaitResponse queue 1
   clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue)
   let clientId = acClientUUID clientIdMsg
   putStrLn $ "received client UUID: " <> show clientId
 
 
   putStrLn welcomeText
-  -- threadDelay $ 15 * 10 ^ 6
+  threadDelay $ 5 * 10 ^ 6
 
 
   sendMessage (ClientMessage clientId ClientRequestWizard) sock
   threadDelay $ 1 * 10 ^ 6
   receiveMessage sock queue
-  whileM_
-    (STM.atomically $ STM.isEmptyTQueue queue)
-    (threadDelay $ 1 * 10 ^ 6)
+  awaitResponse queue 1
   playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
   putStrLn $ "received wizard: " <> show (initWizard playerWizard)
 
@@ -76,3 +74,16 @@ welcomeText = mconcat $ map (<> "\n")
   , ""
   , "Good Luck!"
   ]
+
+awaitResponse
+  :: STM.TQueue ServerMessage
+  -> Int
+  -> IO ()
+awaitResponse _ 10 = error "Tries to communicate with server exceeded"
+awaitResponse queue numTries = do
+  responsePresent <- not <$> STM.atomically (STM.isEmptyTQueue queue)
+  if responsePresent
+  then pure ()
+  else do
+    threadDelay $ 10 ^ 6
+    awaitResponse queue (succ numTries)