summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-11-21 12:34:51 -0500
committerjoe <joe@jerkface.net>2017-11-21 12:34:51 -0500
commit06cb3e9cfd146610892957381df1d8b50eb5eeae (patch)
treed6ac8a2016e5bc5e95379e7dd1beb4a2170aabcb
parent3a7055ddc6b29de004b1e94282a3fb88480d6aec (diff)
Fleshed out some stubs, added comments.
-rw-r--r--examples/dhtd.hs38
1 files changed, 28 insertions, 10 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index fbfca86f..8fd1402d 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -23,6 +23,7 @@ import Control.Applicative
23import Control.Concurrent.STM 23import Control.Concurrent.STM
24import Control.Exception 24import Control.Exception
25import Control.Monad 25import Control.Monad
26import Control.Monad.IO.Class (liftIO)
26import Control.Monad.Trans.Control 27import Control.Monad.Trans.Control
27import Control.Monad.Trans.Resource (runResourceT) 28import Control.Monad.Trans.Resource (runResourceT)
28import Data.Bool 29import Data.Bool
@@ -988,11 +989,17 @@ noArgPing :: (x -> IO (Maybe r)) -> [String] -> x -> IO (Maybe r)
988noArgPing f [] x = f x 989noArgPing f [] x = f x
989noArgPing _ _ _ = return Nothing 990noArgPing _ _ _ = return Nothing
990 991
991newXmmpSource :: Tox.NetCryptoSession -> IO (C.Source IO Tox.CryptoMessage) 992newXmmpSource :: Tox.NetCryptoSession -> C.Source IO Tox.CryptoMessage
992newXmmpSource = _todo 993newXmmpSource sessions = do
994 v <- liftIO $ _todo sessions {- receive a fucking message -}
995 case v of
996 Nothing -> return () -- Nothing indicates EOF.
997 Just cryptomessage -> do C.yield cryptomessage
998 newXmmpSource sessions
993 999
994newXmmpSink :: Tox.NetCryptoSession -> IO (C.Sink (Flush Tox.CryptoMessage) IO ()) 1000newXmmpSink :: Tox.NetCryptoSession -> C.Sink (Flush Tox.CryptoMessage) IO ()
995newXmmpSink = _todo 1001newXmmpSink sessions = C.awaitForever $ \flush_cyptomessage -> do
1002 liftIO $ (_todo sessions {- send the fucking message -}) flush_cyptomessage
996 1003
997-- | TODO 1004-- | TODO
998-- 1005--
@@ -1000,9 +1007,20 @@ newXmmpSink = _todo
1000-- XMPP roster. 1007-- XMPP roster.
1001toxman :: Tox.Tox -> ToxManager k 1008toxman :: Tox.Tox -> ToxManager k
1002toxman tox = ToxManager 1009toxman tox = ToxManager
1003 { activateAccount = \k pubname seckey -> return () 1010 { activateAccount = \k pubname seckey -> do
1004 , deactivateAccount = \k pubname -> return () 1011 -- Schedule recuring announce.
1005 , setToxConnectionPolicy = \me them policy -> return () 1012 -- Schedule recuring search for all non-connected contacts.
1013 return ()
1014 , deactivateAccount = \k pubname -> do
1015 -- If /k/ is the last reference:
1016 -- Stop recuring announce.
1017 -- If this is the last reference to a non-connected contact:
1018 -- Stop the recuring search for that contact
1019 return ()
1020 , setToxConnectionPolicy = \me them policy ->
1021 case policy of
1022 TryingToConnect -> return () -- Add a contact.
1023 _ -> return () -- Remove contact.
1006 } 1024 }
1007 1025
1008 1026
@@ -1325,9 +1343,9 @@ main = runResourceT $ liftBaseWith $ \resT -> do
1325 forM_ (take 1 taddrs) $ \addrTox -> do 1343 forM_ (take 1 taddrs) $ \addrTox -> do
1326 atomically $ Tox.addNewSessionHook netCryptoSessionsState $ \mbNoSpam netcrypto -> do 1344 atomically $ Tox.addNewSessionHook netCryptoSessionsState $ \mbNoSpam netcrypto -> do
1327 let Just pingMachine = Tox.ncPingMachine netcrypto 1345 let Just pingMachine = Tox.ncPingMachine netcrypto
1328 pingflag = readTVar (pingFlag pingMachine) 1346 pingflag = readTVar (pingFlag pingMachine)
1329 xmppSrc <- newXmmpSource netcrypto 1347 xmppSrc = newXmmpSource netcrypto
1330 xmppSink <- newXmmpSink netcrypto 1348 xmppSink = newXmmpSink netcrypto
1331 announceToxXMPPClients (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink 1349 announceToxXMPPClients (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink
1332 1350
1333 let dhts = Map.union btdhts toxdhts 1351 let dhts = Map.union btdhts toxdhts