Ported dhtd to reworked QueryResponse design.

1 files changed, 4 insertions, 1 deletions

diff --git a/dht/src/Network/Tox/AggregateSession.hs b/dht/src/Network/Tox/AggregateSession.hs
index feb634f0..33b1fafb 100644
--- a/dht/src/Network/Tox/AggregateSession.hs
+++ b/dht/src/Network/Tox/AggregateSession.hs
@@ -196,7 +196,10 @@ forkSession c s setStatus = forkIO $ do
         onPacket body loop (ParseError e) = inPrint e >> loop
         onPacket body loop (Arrival _ x)  = body loop x
 
-        awaitPacket body = fix $ join . atomically . awaitMessage (sTransport s) . onPacket body
+        awaitPacket body = fix $ \loop -> do
+            (m,io) <- atomically $ awaitMessage (sTransport s)
+            io
+            onPacket body loop m
 
     atomically $ setStatus $ InProgress AwaitingSessionPacket
     awaitPacket $ \_ online -> do