From fde5005a2d1ef3a0636cff21547d4cda22b7b215 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 17 Aug 2018 05:05:17 -0400 Subject: Simplified PacketQueue/PacketBuffer interface. --- examples/dhtd.hs | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'examples/dhtd.hs') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 2b4de91e..d6049c13 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -1531,7 +1531,7 @@ ioToSource !action !onEOF = liftIO action >>= \case ioToSource action onEOF newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO () -newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do +newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar }) = C.awaitForever $ \flush_cyptomessage -> do let sendit :: Tox.NetCryptoSession -> Flush Tox.CryptoMessage -> IO () sendit session (Chunk msg) = do outq <- atomically $ do @@ -1539,15 +1539,19 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue case mbOutq of Tox.HaveHandshake outq -> return outq Tox.NeedHandshake -> retry - extra <- readyOutGoing outq + extra <- Tox.nqToWireIO outq r <- atomically $ do - rTry <- tryAppendQueueOutgoing extra outq msg + rTry <- Tox.tryAppendQueueOutgoing extra outq msg case rTry of - OGFull -> retry - OGSuccess x -> return (OGSuccess x) - OGEncodeFail -> return OGEncodeFail - when (r == OGEncodeFail) $ - dput XMisc ("FAILURE to Encode Outgoing: " ++ show msg) + Tox.OGFull -> retry + Tox.OGSuccess x -> return (Tox.OGSuccess x) + Tox.OGEncodeFail -> return Tox.OGEncodeFail + case r of + Tox.OGSuccess x -> case Tox.ncSockAddr session of + Tox.HaveDHTKey saddr -> Tox.sendSessionPacket (Tox.ncAllSessions session) saddr x + _ -> return () + Tox.OGEncodeFail -> dput XMisc ("FAILURE to Encode Outgoing: " ++ show msg) + _ -> return () sendit session Flush = return () liftIO $ sendit session flush_cyptomessage -- cgit v1.2.3