{-# LANGUAGE CPP            #-}
{-# LANGUAGE LambdaCase     #-}
{-# LANGUAGE NamedFieldPuns #-}
module ToxManager where

import Announcer
import Connection
-- import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Crypto.Tox
import Data.HashMap.Strict                   as HashMap
import Data.Maybe
import qualified Data.Set                    as Set
import qualified Data.Text                   as T
import Data.Time.Clock.POSIX
import Network.Address
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 System.IO
import Text.Read
import ToxToXMPP
import XMPPServer                            (ConnectionKey)

#ifdef THREAD_DEBUG
import Control.Concurrent.Lifted.Instrument
#else
import Control.Concurrent.Lifted
import GHC.Conc                  (labelThread)
#endif

toxAnnounceInterval :: POSIXTime
toxAnnounceInterval = 15

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)

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