{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} module ToxManager where import Announcer import Announcer.Tox import Connection -- import Control.Concurrent import Control.Concurrent.STM import Control.Monad import Crypto.Tox import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import Data.Maybe import qualified Data.Text as T import Network.Kademlia.Routing as R import Network.Kademlia.Search import qualified Network.Tox as Tox import Network.Tox.ContactInfo as Tox import qualified Network.Tox.Crypto.Handlers as Tox -- import qualified Network.Tox.DHT.Handlers as Tox import qualified Network.Tox.DHT.Transport as Tox import qualified Network.Tox.Onion.Handlers as Tox import qualified Network.Tox.Onion.Transport as Tox import Presence import Text.Read import ToxToXMPP import XMPPServer (ConnectionKey) import DPut toxAnnounceSendData :: Tox.Tox JabberClients -> 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 -- | -- -- 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 JabberClients -> PresenceState -> ToxManager ConnectionKey toxman announcer toxbkts tox presence = ToxManager { activateAccount = \k pubname seckey -> do dput XMan $ "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 Map.empty) return macnt rs <- readTVar $ accountExtra acnt perclient <- initPerClient writeTVar (accountExtra acnt) $! Map.insert k perclient rs modifyTVar accounts (HashMap.insert pubid acnt) if not (Map.null rs) then return (acnt,Nothing) else return (acnt,Just $ \nid -> foldr interweave [] . map (R.kclosest (searchSpace (toxQSearch tox)) searchK nid) <$> mapM (readTVar . snd) toxbkts) forM_ newlyActive $ \nearNodes -> do -- Schedule recurring announce. -- akey <- atomically $ packAnnounceKey announcer $ "toxid:" ++ show pubid scheduleAnnounce announcer akey (AnnounceMethod (toxQSearch tox) (toxAnnounceSendData tox) nearNodes pubid toxAnnounceInterval) pub forkAccountWatcher acnt tox presence announcer return () , deactivateAccount = \k pubname -> do dput XMan $ "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 Map.empty <$> mapM (readTVar . accountExtra) macnt forM_ macnt $ \acnt -> do modifyTVar' (accountExtra acnt) $ Map.delete k return rs if (Map.null $ Map.delete k refs) then do -- TODO -- If this is the last reference to a non-connected contact: -- Stop the recurring search for that contact -- -- Stop recurring announce. akey <- packAnnounceKey announcer ("toxid:" ++ show pubid) fmap Just $ forM toxbkts $ \(nm,bkts) -> do return (akey,bkts) else return Nothing forM_ bStopped $ \kbkts -> do dput XMan $ "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 dput XMan $ "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. }