Factored ToxManager out of the main module.

1 files changed, 1 insertions, 114 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 56d9544d..28e9f261 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -67,6 +67,7 @@ import System.Posix.Signals
 
 
 import Announcer
+import ToxManager
 import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
 import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
@@ -1300,120 +1301,6 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue
     liftIO $ sendit session flush_cyptomessage
 
 
-toxAnnounceSendData :: Tox.Tox -> PublicKey
-                               -> Nonce32
-                               -> Maybe Tox.NodeInfo
-                               -> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
-toxAnnounceSendData tox pubkey token = \case
-    Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
-                                 (Tox.toxCryptoKeys tox)
-                                 (Tox.toxOnion tox)
-                                 (pubkey :: PublicKey)
-                                 (token :: Nonce32)
-                                 ni
-    Nothing -> return Nothing
-
-toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
-toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)
-
-toxAnnounceInterval :: POSIXTime
-toxAnnounceInterval = 15
-
--- |
---
--- These hooks will be invoked in order to connect to *.tox hosts in a user's
--- XMPP roster.
-toxman :: Announcer -> [(String,TVar (BucketList Tox.NodeInfo))] -> Tox.Tox -> PresenceState -> ToxManager ConnectionKey
-toxman announcer toxbkts tox presence = ToxManager
-    { activateAccount        = \k pubname seckey -> do
-        hPutStrLn stderr $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
-        let ContactInfo{ accounts } = Tox.toxContactInfo tox
-            pub = toPublic seckey
-            pubid = Tox.key2id pub
-        (acnt,newlyActive) <- atomically $ do
-            macnt <- HashMap.lookup pubid <$> readTVar accounts
-            acnt <- maybe (newAccount seckey) return macnt
-            rs <- readTVar $ clientRefs acnt
-            writeTVar (clientRefs acnt) $! Set.insert k rs
-            modifyTVar accounts (HashMap.insert pubid acnt)
-            if not (Set.null rs)
-                then return (acnt,[])
-                else do
-                    fmap ((,) acnt) $ forM toxbkts $ \(nm,bkts) -> do
-                        akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
-                        return (akey,bkts)
-        forM_ newlyActive $ \(akey,bkts) -> do
-            -- Schedule recurring announce.
-            --
-            schedule announcer
-                     akey
-                     (AnnounceMethod (toxQSearch tox)
-                                     (Right $ toxAnnounceSendData tox)
-                                     bkts
-                                     pubid
-                                     toxAnnounceInterval)
-                     pub
-
-            forkAccountWatcher acnt tox presence
-            return ()
-
-    , deactivateAccount      = \k pubname -> do
-       hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname
-       let ContactInfo{ accounts } = Tox.toxContactInfo tox
-           mpubid = readMaybe $ T.unpack $ T.take 43 pubname
-       bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
-        forM mpubid $ \pubid -> do
-        refs <- do
-            macnt <- HashMap.lookup pubid <$> readTVar accounts
-            rs <- fromMaybe Set.empty <$> mapM (readTVar . clientRefs) macnt
-            forM_ macnt $ \acnt -> do
-                modifyTVar' (clientRefs acnt) $ Set.delete k
-            return rs
-        if (Set.null $ refs Set.\\ Set.singleton k) then do
-            --   TODO
-            --   If this is the last reference to a non-connected contact:
-            --      Stop the recurring search for that contact
-            --
-            -- Stop recurring announce.
-            fmap Just $ forM toxbkts $ \(nm,bkts) -> do
-                akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
-                return (akey,bkts)
-        else return Nothing
-       forM_ bStopped $ \kbkts -> do
-           hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname
-           let Just pubid = mpubid
-               pub        = Tox.id2key pubid
-           forM_ kbkts $ \(akey,bkts) -> do
-                cancel announcer
-                     akey
-                     (AnnounceMethod (toxQSearch tox)
-                                     (Right $ toxAnnounceSendData tox)
-                                     bkts
-                                     pubid
-                                     toxAnnounceInterval)
-                     pub
-
-    , setToxConnectionPolicy = \me them p -> do
-       let m = do meid   <- readMaybe $ T.unpack $ T.take 43 me
-                  themid <- readMaybe $ T.unpack $ T.take 43 them
-                  return $ Tox.Key meid themid
-       hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
-       forM_  m $ \k -> do
-       setPolicy (Tox.toxMgr tox) k p
-       case p of
-        TryingToConnect -> do
-            let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
-            sequence_ $ do
-            let Tox.Key meid themid = k
-            Just $ atomically $ do
-            accs <- readTVar accounts
-            case HashMap.lookup meid accs of
-                Nothing  -> return () -- Unknown account.
-                Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
-            -- If unscheduled and unconnected, schedule recurring search for this contact.
-        _ -> return () -- Remove contact.
-    }
-
 -- | Called upon a new Tox friend-connection session with a remote peer in
 -- order to set up translating conduits that simulate a remote XMPP server.
 announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.