{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
#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.Monad
import Control.Monad.STM
import Crypto.Tox
import qualified Data.IntMap.Strict          as IntMap
import Data.Function
import DebugUtil
import DPut
import DebugTag
import HandshakeCache
import Network.QueryResponse
import Network.Socket
import Network.Tox
import Network.Tox.ContactInfo
import Network.Tox.Session
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
import Data.Dependent.Sum
import Data.Tox.Msg

makeToxNode :: UDPTransport -> Maybe SecretKey
        -> ( ContactInfo extra -> SockAddr -> Session -> IO () )
        -> IO (Tox extra)
makeToxNode udp sec onSessionF = do
    keysdb <- newKeysDatabase
    newToxOverTransport keysdb
                        (SockAddrInet 0 0)
                        onSessionF
                        sec
                        udp
                        (\_ _ -> return ())


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

sessionChan :: TVar (Map.Map PublicKey [Session]) -> TChan (TMChan CryptoMessage)
                -> ContactInfo extra -> SockAddr -> Session -> IO ()
sessionChan remotes tchan acnt saddr s = do
    ch <- atomically $ do
        modifyTVar' remotes $  (`Map.alter` sTheirUserKey s) $ \case
            Just ss  -> Just (s : ss)
            Nothing  -> Just [s]
        session_chan <- newTMChan
        writeTChan tchan session_chan
        return session_chan
    let onPacket loop Nothing          = return ()
        onPacket loop (Just (Left e))  = dput XUnused e >> loop
        onPacket loop (Just (Right (x,()))) = do
            atomically $ writeTMChan ch x
            loop
    -- forkIO $ fix $ awaitMessage (sTransport s) . onPacket
    return ()

netCrypto :: Tox extra -> SecretKey -> NodeInfo -> PublicKey -> IO ()
netCrypto tox me ni them = do
    mcookie <- cookieRequest (toxCryptoKeys tox) (toxDHT tox) (toPublic me) ni
    case mcookie of
        Just cookie -> do
            hs <- cacheHandshake (toxHandshakeCache tox) me them ni cookie
            sendMessage (toxHandshakes tox) (nodeAddr ni) hs
        Nothing -> do
            dput XUnused "Timeout requesting cookie."


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

    (udpA,udpB) <- testPairTransport

    a_remotes <- atomically (newTVar Map.empty)
    a_sessions <- atomically newTChan
    a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
        <- makeToxNode udpA (decodeSecret "YrJQFG7Xppg4WAyhooONNGSCRVQbrRF9L4VoQQsetF")
                            (sessionChan a_remotes a_sessions)
    a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
        `setToxID` -- BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI
            decodeSecret "UdZUB9Mf1RD3pVGh02OsRJM6YpmGqJiVxYGVIVHkAG"

    -- a_sessions <- sessionChan a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf

    b_remotes <- atomically (newTVar Map.empty)
    b_sessions <- atomically newTChan
    let b = read "OM7znaPMYkTbm.9GcZJAdnDATXmZxZ9fnaSTP3qNCZk@2.0.0.0:2"
    b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
        <- makeToxNode udpB (decodeSecret "Lm2pnsu1+80I8h9txMoZyGgcNwfaoqBlIfg5TwWUXL")
                            (sessionChan b_remotes b_sessions)
    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"
        netCrypto a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf a_secret b b_public
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        dput XUnused "REACHEDREACHEDREACHEDREACHED"
        threadDelay 1000000
        -- a says "Howdy"
        mp_a <- atomically . readTVar $ a_remotes
        case Map.lookup b_public mp_a of
            Just [session] -> do
                dput XUnused "----------------- HOWDY ---------------"
                sendMessage (sTransport session) () (Pkt MESSAGE :=> "Howdy")
            Just xs -> dput XUnused "Unexpectedly a has TOO MANY sesions for b"
            Nothing -> dput XUnused "Unexpectedly a has NO session for b"
        -- b says "Hey you!"
        mp_b <- atomically . readTVar $ b_remotes
        case Map.lookup a_public mp_b of
            Just [session] -> do
                dput XUnused "----------------- HEY YOU ---------------"
                sendMessage (sTransport session) () (Pkt MESSAGE :=> "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