{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
#ifdef THREAD_DEBUG
import Control.Concurrent.Lifted.Instrument
#else
import Control.Concurrent.Lifted
#endif
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TMChan
import Control.Concurrent.STM.TVar
import Control.Concurrent.Supply
import Control.Monad
import Control.Monad.STM
import Crypto.Tox
import qualified Data.IntMap.Strict          as IntMap
import DebugUtil
import DPut
import Network.QueryResponse
import Network.Socket
import Network.Tox
import Network.Tox.ContactInfo
import qualified Network.Tox.Crypto.Handlers as CH
import Network.Tox.Crypto.Transport
import Network.Tox.DHT.Handlers              as DHT
import Network.Tox.DHT.Transport
import Network.Tox.Onion.Transport
import Connection
import qualified Data.HashMap.Strict as HashMap
         ;import Data.HashMap.Strict (HashMap)
import qualified Data.Map.Strict as Map
import Data.Time.Clock.POSIX
import System.Exit


makeToxNode :: UDPTransport -> Maybe SecretKey -> IO (Tox extra)
makeToxNode udp sec = do
    keysdb <- newKeysDatabase
    newToxOverTransport keysdb
                        (SockAddrInet 0 0)
                        Nothing
                        sec
                        udp


setToxID :: Tox () -> Maybe SecretKey -> IO ()
setToxID tox (Just sec) = atomically $ addContactInfo (toxContactInfo tox) sec ()

sessionChan :: Tox extra -> IO (TChan (TMChan CryptoMessage))
sessionChan Tox{toxCryptoSessions} = do
    tchan <- atomically newTChan
    atomically $ CH.addNewSessionHook toxCryptoSessions $ \_ nc -> do
        atomically $ do
            session_chan <- newTMChan
            writeTChan tchan session_chan
            (n,supply) <- freshId <$> readTVar (CH.listenerIDSupply toxCryptoSessions)
            writeTVar (CH.listenerIDSupply toxCryptoSessions) supply
            modifyTVar' (CH.ncListeners nc) $ IntMap.insert n (0,session_chan)
        return Nothing
    return tchan


main :: IO ()
main = do
    mapM_ setVerbose [ minBound .. maxBound ]
    setQuiet XRoutes

    (udpA,udpB) <- testPairTransport

    a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
        <- makeToxNode udpA $ decodeSecret "YrJQFG7Xppg4WAyhooONNGSCRVQbrRF9L4VoQQsetF"
    a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
        `setToxID` -- BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI
            decodeSecret "UdZUB9Mf1RD3pVGh02OsRJM6YpmGqJiVxYGVIVHkAG"

    a_sessions <- sessionChan a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf

    let b = read "OM7znaPMYkTbm.9GcZJAdnDATXmZxZ9fnaSTP3qNCZk@2.0.0.0:2"
    b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
        <- makeToxNode udpB $ decodeSecret "Lm2pnsu1+80I8h9txMoZyGgcNwfaoqBlIfg5TwWUXL"
    b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
        `setToxID` -- AvETKhO-YqnNRopZrj8K3xUpGtGbX0sLhZZjh2VufJB
            decodeSecret "L7WNtNIbm0ajNlPrkWvSRpn0nypTUZxlHBckZPlTje"

    b_sessions <- sessionChan b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk

    (a_quit,_,_) <- forkTox a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf False
    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False

    threadReport False >>= putStrLn

    [(a_secret,a_public)] <- atomically (userKeys (toxCryptoKeys a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf))
    [(_,b_public)] <- atomically (userKeys (toxCryptoKeys b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk))
    mbAccount <- atomically $ do
        accs <- readTVar (accounts $ toxContactInfo a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf)
        return $ HashMap.lookup (key2id a_public) accs
    now <- getPOSIXTime
    case mbAccount of
       Just account -> atomically $ do
            setContactPolicy b_public TryingToConnect account
            setContactAddr now b_public b account
       Nothing -> dput XUnused "MISSING Account!"

    dput XUnused $ "a_public = " ++ show (key2id a_public)
    dput XUnused $ "BDD... = " ++ show (read "BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI":: NodeId)

    -- Tell /a/ about /b/'s DHT-key.
    updateContactInfo (toxContactInfo a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf)
                      (AnnouncedRendezvous (id2key $ read "AvETKhO-YqnNRopZrj8K3xUpGtGbX0sLhZZjh2VufJB") -- b toxid
                                           (Rendezvous (error "pointless mitm key") b))
                    $ ( id2key $ read "BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI" -- a toxid
                      , OnionDHTPublicKey DHTPublicKey
                        { dhtpkNonce = 0
                        , dhtpk      = id2key $ nodeId b
                        , dhtpkNodes = SendNodes []
                        }
                      )

    DHT.ping (toxDHT a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) b

    -- sendMessage (toxHandshakes a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (nodeAddr b) hs

    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False

    forkIO $ do
        tid <- myThreadId
        labelThread tid "testToxLaunch"
        void $ netCrypto a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf a_secret b_public
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        threadDelay 1000000
        -- a says "Howdy"
        mp_a <- atomically . readTVar $ CH.netCryptoSessionsByKey (toxCryptoSessions a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf)
        case Map.lookup b_public mp_a of
            Just [session] -> do
                dput XUnused "----------------- HOWDY ---------------"
                CH.sendChatMsg (toxCryptoKeys a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) session "Howdy"
        -- b says "Hey you!"
        mp_b <- atomically . readTVar $ CH.netCryptoSessionsByKey (toxCryptoSessions b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk)
        case Map.lookup a_public mp_b of
            Just [session] -> do
                dput XUnused "----------------- HEY YOU ---------------"
                void $ CH.sendChatMsg (toxCryptoKeys b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk) session "Hey you!"
            Just xs -> dput XUnused "Unexpectedly b has TOO MANY sesions for a"
            Nothing -> dput XUnused "Unexpectedly b has NO session for a"

    putStrLn "Type Enter to quit..."
    getLine

    a_quit
    b_quit

    threadDelay 500000
    threadReport False >>= putStrLn