diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 6e2647d1..1aa36b77 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -94,6 +94,7 @@ import Data.Typeable | |||
94 | import Network.Tox.ContactInfo as Tox | 94 | import Network.Tox.ContactInfo as Tox |
95 | import OnionRouter | 95 | import OnionRouter |
96 | import PingMachine | 96 | import PingMachine |
97 | import Data.PacketQueue | ||
97 | 98 | ||
98 | -- Presence imports. | 99 | -- Presence imports. |
99 | import ConsoleWriter | 100 | import ConsoleWriter |
@@ -998,8 +999,20 @@ newXmmpSource session = do | |||
998 | newXmmpSource session | 999 | newXmmpSource session |
999 | 1000 | ||
1000 | newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO () | 1001 | newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO () |
1001 | newXmmpSink sessions = C.awaitForever $ \flush_cyptomessage -> do | 1002 | newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do |
1002 | liftIO $ (_todo sessions {- send the fucking message -}) flush_cyptomessage | 1003 | let sendit :: Tox.NetCryptoSession -> Flush Tox.CryptoMessage -> IO () |
1004 | sendit session (Chunk msg) = do | ||
1005 | extra <- readyOutGoing ncOutgoingQueue | ||
1006 | r <- atomically $ do | ||
1007 | rTry <- tryAppendQueueOutgoing extra ncOutgoingQueue msg | ||
1008 | case rTry of | ||
1009 | OGFull -> retry | ||
1010 | OGSuccess -> return OGSuccess | ||
1011 | OGEncodeFail -> return OGEncodeFail | ||
1012 | when (r == OGEncodeFail) $ | ||
1013 | hPutStrLn stderr ("FAILURE to Encode Outgoing: " ++ show msg) | ||
1014 | sendit session Flush = return () | ||
1015 | liftIO $ sendit session flush_cyptomessage | ||
1003 | 1016 | ||
1004 | -- | TODO | 1017 | -- | TODO |
1005 | -- | 1018 | -- |