1 files changed, 23 insertions, 7 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 89b747be..088e0c67 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -21,6 +21,7 @@ module Main where
 import Control.Arrow
 import Control.Applicative
 import Control.Concurrent.STM
+import Control.Concurrent.STM.TMChan
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
@@ -88,7 +89,7 @@ import qualified Network.Tox.DHT.Transport as Tox
 import qualified Network.Tox.DHT.Handlers as Tox
 import qualified Network.Tox.Onion.Transport as Tox
 import qualified Network.Tox.Onion.Handlers as Tox
-import qualified Network.Tox.Crypto.Transport as Tox (CryptoMessage)
+import qualified Network.Tox.Crypto.Transport as Tox (CryptoMessage(..),CryptoData(..), isOFFLINE, isKillPacket)
 import qualified Network.Tox.Crypto.Handlers as Tox
 import Data.Typeable
 import Network.Tox.ContactInfo as Tox
@@ -1000,13 +1001,14 @@ noArgPing :: (x -> IO (Maybe r)) -> [String] -> x -> IO (Maybe r)
 noArgPing f [] x = f x
 noArgPing _ _  _ = return Nothing
 
-newXmmpSource :: Tox.NetCryptoSession -> C.Source IO Tox.CryptoMessage
-newXmmpSource session = do
-    v <- liftIO $ Tox.receiveCrypto session
+-- todo: session parameter obsolete?
+newXmmpSource :: (IO (Maybe Tox.CryptoMessage)) -> Tox.NetCryptoSession -> C.Source IO Tox.CryptoMessage
+newXmmpSource receiveCrypto session = do
+    v <- liftIO receiveCrypto
     case v of
         Nothing            -> return () -- Nothing indicates EOF.
         Just cryptomessage -> do C.yield cryptomessage
-                                 newXmmpSource session
+                                 newXmmpSource receiveCrypto session
 
 newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO ()
 newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue, ncPacketQueue }) = C.awaitForever $ \flush_cyptomessage -> do
@@ -1046,6 +1048,7 @@ toxman tox = ToxManager
                                         _               -> return () -- Remove contact.
     }
 
+#ifdef XMPP
 
 announceToxXMPPClients :: TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event)
                       -> SockAddr
@@ -1064,7 +1067,7 @@ announceToxXMPPClients echan laddr saddr pingflag tsrc tsnk
     xsrc = tsrc =$= toxToXmpp
     xsnk = flushPassThrough xmppToTox =$= tsnk
 
-
+#endif
 
 main :: IO ()
 main = runResourceT $ liftBaseWith $ \resT -> do
@@ -1379,11 +1382,24 @@ main = runResourceT $ liftBaseWith $ \resT -> do
 
     forM_ (take 1 taddrs) $ \addrTox -> do
         atomically $ Tox.addNewSessionHook netCryptoSessionsState $ \mbNoSpam netcrypto -> do
+            tmchan <- atomically newTMChan
             let Just pingMachine = Tox.ncPingMachine netcrypto
                 pingflag         = readTVar (pingFlag pingMachine)
-                xmppSrc          = newXmmpSource netcrypto
+                receiveCrypto    = atomically $ readTMChan tmchan
+                handleIncoming typ session cd | any ($ typ) [Tox.isKillPacket, Tox.isOFFLINE] = atomically $ do
+                    closeTMChan tmchan
+                    Tox.forgetCrypto crypto netCryptoSessionsState netcrypto
+                    return Nothing
+                handleIncoming mTyp session cd = do
+                    atomically $ writeTMChan tmchan (Tox.bufferData cd)
+                    return Nothing
+#ifdef XMPP
+                xmppSrc          = newXmmpSource receiveCrypto netcrypto
                 xmppSink         = newXmmpSink netcrypto
             announceToxXMPPClients (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink
+#endif
+            atomically $ writeTVar (Tox.ncUnrecognizedHook netcrypto) handleIncoming
+            return Nothing
 
     let dhts = Map.union btdhts toxdhts