{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent                    (threadDelay)
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TMChan
import Control.Concurrent.STM.TVar
import Control.Concurrent.Supply
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


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

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


    putStrLn "Type Enter to quit..."
    getLine

    a_quit
    b_quit

    threadDelay 500000
    threadReport False >>= putStrLn