remove client deadlocks

This commit is contained in:
nek0 2023-12-12 09:01:21 +01:00
parent 087ae2d072
commit 13a4022547

View file

@ -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)