summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs17
1 files changed, 11 insertions, 6 deletions
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
1369 ioToSource action onEOF 1369 ioToSource action onEOF
1370 1370
1371newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO () 1371newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO ()
1372newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = Tox.HaveHandshake outq, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do 1372newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do
1373 let sendit :: Tox.NetCryptoSession -> Flush Tox.CryptoMessage -> IO () 1373 let sendit :: Tox.NetCryptoSession -> Flush Tox.CryptoMessage -> IO ()
1374 sendit session (Chunk msg) = do 1374 sendit session (Chunk msg) = do
1375 outq <- atomically $ do
1376 mbOutq <- readTVar outGoingQVar
1377 case mbOutq of
1378 Tox.HaveHandshake outq -> return outq
1379 Tox.NeedHandshake -> retry
1375 extra <- readyOutGoing outq 1380 extra <- readyOutGoing outq
1376 r <- atomically $ do 1381 r <- atomically $ do
1377 rTry <- tryAppendQueueOutgoing extra outq msg 1382 rTry <- tryAppendQueueOutgoing extra outq msg
1378 case rTry of 1383 case rTry of
1379 OGFull -> retry 1384 OGFull -> retry
1380 OGSuccess -> return OGSuccess 1385 OGSuccess -> return OGSuccess
1381 OGEncodeFail -> return OGEncodeFail 1386 OGEncodeFail -> return OGEncodeFail
1382 when (r == OGEncodeFail) $ 1387 when (r == OGEncodeFail) $
1383 hPutStrLn stderr ("FAILURE to Encode Outgoing: " ++ show msg) 1388 hPutStrLn stderr ("FAILURE to Encode Outgoing: " ++ show msg)
1384 sendit session Flush = return () 1389 sendit session Flush = return ()