{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeOperators              #-}
module Network.Tox.Transport (toxTransport, RouteId) where

import Network.QueryResponse
import Crypto.Tox
import Data.Tox.Relay as TCP
import qualified Data.Tox.DHT.Multi as Multi
import Network.Tox.DHT.Transport as UDP
import Network.Tox.TCP (ViaRelay)
import Network.Tox.Onion.Transport
import Network.Tox.Crypto.Transport
import Network.Tox.Onion.Routes

import Control.Applicative
import Control.Concurrent.STM
import qualified Data.ByteString    as B
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum
import Data.Functor.Identity
import Data.Maybe
import Network.Socket

pendingCookiesUDP :: TransportCrypto -> SockAddr -> STM (Maybe UDP.NodeInfo)
pendingCookiesUDP crypto saddr = do
    cs <- readTVar $ pendingCookies crypto
    return $ do
        (_,key) <- lookup saddr cs <|> listToMaybe (map snd cs)
        either (const Nothing) Just $ nodeInfo (key2id key) saddr

pendingCookiesTCP :: ViaRelay -> STM (Maybe ViaRelay)
pendingCookiesTCP ni = return $ Just ni

toxTransport ::
      TransportCrypto
          -> OnionRouter
          -> (PublicKey -> IO (Maybe UDP.NodeInfo))
          -> SockAddr -- ^ UDP bind-address
          -> UDPTransport
          -> Transport String ViaRelay B.ByteString
          -> (TCP.NodeInfo -> RelayPacket -> IO ())   -- ^ (UNUSED) TCP server-bound callback.
          -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
          -> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted)
                , Transport String Multi.NodeInfo (DHTMessage Encrypted8)
                , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                , Transport String Multi.SessionAddress (Handshake Encrypted))
toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do
    (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
    (dhtUDP,udp1) <- partitionTransportM (parseDHTAddr (pendingCookiesUDP crypto) nodeInfo)
                                         (fmap Just . encodeDHTAddr nodeAddr)
                                    $ forwardOnions crypto addr udp0 tcp2client
    -- rlynet0 = layerTransportM (DHT.decrypt crypto Multi.relayNodeId) (DHT.encrypt crypto Multi.relayNodeId) relaynet
    (netcryptoTCP, relaynet0) <- partitionTransport parseCrypto encodeCrypto relaynet
    (dhtTCP,relaynet1) <- partitionTransportM
                            (parseDHTAddr pendingCookiesTCP (\nid viarelay -> Right viarelay))
                            (fmap Just . encodeDHTAddr id)
                            relaynet0
    let _ = dhtTCP :: Transport String ViaRelay (DHTMessage Encrypted8)
    dht <- mergeTransports $ DMap.fromList
        [ Multi.UDP :=> ByAddress dhtUDP
        , Multi.TCP :=> ByAddress dhtTCP
        ]
    (onion,udp2) <- partitionTransportM
                             (parseOnionAddr $ lookupSender orouter)
                             (encodeOnionAddr crypto $ lookupRoute orouter)
                             udp1
    multi_netcrypto <- mergeTransports $ DMap.fromList
        [ Multi.SessionUDP :=> ByAddress netcrypto
        , Multi.SessionTCP :=> ByAddress netcryptoTCP ]
    let handshakes = layerTransport parseHandshakes encodeHandshakes udp2
        handshakesTCP = layerTransport parseHandshakes encodeHandshakes relaynet1
    multi_handshakes <- mergeTransports $ DMap.fromList
        [ Multi.SessionUDP :=> ByAddress handshakes
        , Multi.SessionTCP :=> ByAddress handshakesTCP ]
    return ( multi_netcrypto
           , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht
           , onion
           , multi_handshakes
           )


-- instance (Sized a, Sized b) => Sized (a,b) where size = _todo


--   Byte value   Packet Kind           Return address
-- :----------- :--------------------
--   `0x00`       Ping Request          DHTNode
--   `0x01`       Ping Response         -
--   `0x02`       Nodes Request         DHTNode
--   `0x04`       Nodes Response        -
--   `0x18`       Cookie Request        DHTNode, but without sending pubkey in response
--   `0x19`       Cookie Response       - (no pubkey)
--
--   `0x21`       LAN Discovery         DHTNode (No reply, port 33445, trigger Nodes Request/Response)
--
--   `0x20`       DHT Request           DHTNode/-forward
--
--   `0x1a`       Crypto Handshake      CookieAddress
--
--   `0x1b`       Crypto Data           SessionAddress
--
--   `0x83`       Announce Request      OnionToOwner
--   `0x84`       Announce Response     -
--   `0x85`       Onion Data Request    OnionToOwner
--   `0x86`       Onion Data Response   -
--
--   `0xf0`       Bootstrap Info        SockAddr?
--
--   `0x80`       Onion Request 0       -forward
--   `0x81`       Onion Request 1       -forward
--   `0x82`       Onion Request 2       -forward
--   `0x8c`       Onion Response 3      -return
--   `0x8d`       Onion Response 2      -return
--   `0x8e`       Onion Response 1      -return