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 (Options socketLocation) <- execParser opts
putStrLn $ "connecting to Socket " <> socketLocation putStrLn $ "connecting to Socket " <> socketLocation
sock <- connectSocket socketLocation sock <- connectSocket socketLocation
queue <- STM.newTQueueIO
putStrLn "connected" putStrLn "connected"
queue <- STM.newTQueueIO
sendMessage (IdRequest) sock sendMessage (IdRequest) sock
threadDelay $ 1 * 10 ^ 6 threadDelay $ 1 * 10 ^ 6
receiveMessage sock queue receiveMessage sock queue
whileM_ awaitResponse queue 1
(STM.atomically $ STM.isEmptyTQueue queue)
(threadDelay $ 1 * 10 ^ 6)
clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue) clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue)
let clientId = acClientUUID clientIdMsg let clientId = acClientUUID clientIdMsg
putStrLn $ "received client UUID: " <> show clientId putStrLn $ "received client UUID: " <> show clientId
putStrLn welcomeText putStrLn welcomeText
-- threadDelay $ 15 * 10 ^ 6 threadDelay $ 5 * 10 ^ 6
sendMessage (ClientMessage clientId ClientRequestWizard) sock sendMessage (ClientMessage clientId ClientRequestWizard) sock
threadDelay $ 1 * 10 ^ 6 threadDelay $ 1 * 10 ^ 6
receiveMessage sock queue receiveMessage sock queue
whileM_ awaitResponse queue 1
(STM.atomically $ STM.isEmptyTQueue queue)
(threadDelay $ 1 * 10 ^ 6)
playerWizard <- head <$> STM.atomically (STM.flushTQueue queue) playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
putStrLn $ "received wizard: " <> show (initWizard playerWizard) putStrLn $ "received wizard: " <> show (initWizard playerWizard)
@ -76,3 +74,16 @@ welcomeText = mconcat $ map (<> "\n")
, "" , ""
, "Good Luck!" , "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)