From 86262384f4338bb64cca424bc1d444d29fc6b28c Mon Sep 17 00:00:00 2001 From: James Crayne Date: Thu, 31 May 2018 18:26:15 +0000 Subject: more careful updateCryptoSession --- examples/dhtd.hs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'examples/dhtd.hs') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index fdbe7719..f6a838aa 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -1369,16 +1369,21 @@ ioToSource !action !onEOF = liftIO action >>= \case ioToSource action onEOF newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO () -newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = Tox.HaveHandshake outq, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do +newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do let sendit :: Tox.NetCryptoSession -> Flush Tox.CryptoMessage -> IO () sendit session (Chunk msg) = do + outq <- atomically $ do + mbOutq <- readTVar outGoingQVar + case mbOutq of + Tox.HaveHandshake outq -> return outq + Tox.NeedHandshake -> retry extra <- readyOutGoing outq r <- atomically $ do - rTry <- tryAppendQueueOutgoing extra outq msg - case rTry of - OGFull -> retry - OGSuccess -> return OGSuccess - OGEncodeFail -> return OGEncodeFail + rTry <- tryAppendQueueOutgoing extra outq msg + case rTry of + OGFull -> retry + OGSuccess -> return OGSuccess + OGEncodeFail -> return OGEncodeFail when (r == OGEncodeFail) $ hPutStrLn stderr ("FAILURE to Encode Outgoing: " ++ show msg) sendit session Flush = return () -- cgit v1.2.3