{-# 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                            (ClientAddress)
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

akeyAccountActive :: Announcer -> Tox.NodeId{- our public tox key -} -> AnnounceKey
akeyAccountActive announcer pubid = packAnnounceKey announcer $ "toxid:" ++ show pubid

-- |
--
-- 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 ClientAddress
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.
            --
            let akey = akeyAccountActive announcer 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
                -- Remove this xmpp client /k/ from the set holding this
                -- account active.
                modifyTVar' (accountExtra acnt) $ Map.delete k
            return rs
        if (Map.null $ Map.delete k refs) then do
            let akey = akeyAccountActive announcer pubid
            fmap Just $ forM toxbkts $ \(nm,bkts) -> do
                return (akey,bkts)
        else return Nothing
       forM_ bStopped $ \kbkts -> do
           let Just pubid = mpubid
               pub        = Tox.id2key pubid
           -- Stop the announce-toxid task for this account.  Note that other
           -- announced tasks will be stopped by the forkAccountWatcher thread
           -- when it terminates.
           forM_ kbkts $ \(akey,bkts) -> do
                cancel announcer akey

    , 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.
    }