{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
module Data.Tox.DHT.Multi where

import Crypto.PubKey.Curve25519 (PublicKey)
import qualified Network.Tox.NodeId as UDP
         ;import Network.Tox.NodeId (NodeId)
import qualified Network.Tox.TCP.NodeId as TCP
import Data.Tox.Onion (OnionDestination,RouteId)
import Data.Tox.Relay hiding (NodeInfo)
import Network.Address as SockAddr (canonize)
import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_)
import Network.QueryResponse as QR (Tagged(..), Client)

import Data.Dependent.Sum
import Data.GADT.Compare
import Data.GADT.Show
import Data.Functor.Identity
import Data.Typeable
import Network.Socket

#if MIN_VERSION_dependent_sum(0,6,0)
import Data.Constraint.Compose
import Data.Constraint.Extras
import Data.Constraint.Extras.TH
#endif


data T ni where
    UDP :: T UDP.NodeInfo
    TCP :: T TCP.ViaRelay

instance GEq T where
    geq UDP UDP = Just Refl
    geq TCP TCP = Just Refl
    geq _   _   = Nothing
instance GCompare T where
    gcompare UDP UDP = GEQ
    gcompare UDP TCP = GLT
    gcompare TCP TCP = GEQ
    gcompare TCP UDP = GGT
instance GShow T where
    gshowsPrec _ UDP = showString "UDP"
    gshowsPrec _ TCP = showString "TCP"

data S addr where
    SessionUDP :: S SockAddr
    SessionTCP :: S TCP.ViaRelay

instance GEq S where
    geq SessionUDP SessionUDP = Just Refl
    geq SessionTCP SessionTCP = Just Refl
    geq _          _          = Nothing
instance GCompare S where
    gcompare SessionUDP SessionUDP = GEQ
    gcompare SessionUDP SessionTCP = GLT
    gcompare SessionTCP SessionTCP = GEQ
    gcompare SessionTCP SessionUDP = GGT
instance GShow S where
    gshowsPrec _ SessionUDP = showString "UDP"
    gshowsPrec _ SessionTCP = showString "TCP"

data O addr where
    OnionUDP :: O (OnionDestination RouteId)
    OnionTCP :: O (OnionDestination RouteId)

instance GEq O where
    geq OnionUDP OnionUDP = Just Refl
    geq OnionTCP OnionTCP = Just Refl
    geq _          _          = Nothing
instance GCompare O where
    gcompare OnionUDP OnionUDP = GEQ
    gcompare OnionUDP OnionTCP = GLT
    gcompare OnionTCP OnionTCP = GEQ
    gcompare OnionTCP OnionUDP = GGT
instance GShow O where
    gshowsPrec _ OnionUDP = showString "UDP"
    gshowsPrec _ OnionTCP = showString "TCP"

untagOnion :: DSum O Identity -> OnionDestination RouteId
untagOnion (OnionUDP :=> Identity o) = o
untagOnion (OnionTCP :=> Identity o) = o

-- Canonical in case of 6-mapped-4 addresses.
canonize :: DSum S Identity -> DSum S Identity
canonize (SessionUDP :=> Identity saddr) = SessionUDP ==> SockAddr.canonize saddr
canonize taddr                           = taddr

type NodeInfo = DSum T Identity
type SessionAddress = DSum S Identity
type OnionAddress = DSum O Identity

#if MIN_VERSION_dependent_sum(0,6,0)
deriveArgDict ''T
deriveArgDict ''S
deriveArgDict ''O
#else
instance ShowTag T Identity where
    showTaggedPrec UDP = showsPrec
    showTaggedPrec TCP = showsPrec
instance ShowTag S Identity where
    showTaggedPrec SessionUDP = showsPrec
    showTaggedPrec SessionTCP = showsPrec
instance ShowTag O Identity where
    showTaggedPrec OnionUDP = showsPrec
    showTaggedPrec OnionTCP = showsPrec
instance EqTag S Identity where
    eqTagged SessionUDP SessionUDP = (==)
    eqTagged SessionTCP SessionTCP = (==)
instance OrdTag S Identity where
    compareTagged SessionUDP SessionUDP = compare
    compareTagged SessionTCP SessionTCP = compare
#endif


nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity)
nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
nodeInfo nid (SessionTCP :=> Identity taddr@(ViaRelay _ nid2 _)) =
    if nid2 == nid then Right $ TCP ==> taddr
                   else Left $ "Cached dht-key("++show nid2++") doesn't match "++show nid

nodeId :: DSum T Identity -> NodeId
nodeId (UDP :=> Identity ni                ) = UDP.nodeId ni
nodeId (TCP :=> Identity (ViaRelay _ nid _)) = nid

relayNodeId :: TCP.ViaRelay -> UDP.NodeId
relayNodeId (ViaRelay _ nid _) = nid

udpNode :: DSum T Identity -> Maybe UDP.NodeInfo
udpNode (UDP :=> Identity ni) = Just ni
udpNode _                     = Nothing

sessionAddr :: DSum T Identity -> DSum S Identity
sessionAddr (UDP :=> Identity ni) = SessionUDP ==> UDP.nodeAddr ni
sessionAddr (TCP :=> Identity vr) = SessionTCP ==> vr

tcpConnectionRequest :: QR.Client err PacketNumber tid TCP.NodeInfo (Bool, RelayPacket)
                        -> PublicKey -> TCP.NodeInfo -> IO (Maybe NodeInfo)
tcpConnectionRequest client pubkey ni = do
    mcon <- tcpConnectionRequest_ client pubkey ni
    return $ fmap (\conid -> TCP ==> ViaRelay (Just conid) (UDP.key2id pubkey) ni) mcon

showSessionAddr :: SessionAddress -> String
showSessionAddr (SessionUDP :=> Identity udp) =
    show (SockAddr.canonize udp)
showSessionAddr (SessionTCP :=> Identity (ViaRelay mcon _ tcp)) =
    "TCP:" ++ maybe "(oob)" (\(ConId con) -> "(" ++ show con ++ ")") mcon ++ show tcp