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

import qualified Network.Tox.NodeId as UDP
         ;import Network.Tox.NodeId (NodeId)
import qualified Network.Tox.TCP.NodeId as TCP
import Data.Tox.Relay
import Network.Address (either4or6)
import Network.Tox.TCP as TCP (ViaRelay(..))
import Network.QueryResponse (Tagged(..))

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"

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

data A addr where
    AddrUDP :: SockAddr -> A UDP.NodeInfo
    AddrTCP :: Maybe ConId -> TCP.NodeInfo -> A TCP.ViaRelay

deriving instance Eq (A addr)

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

type Address = DSum T A

#if MIN_VERSION_dependent_sum(0,6,0)
deriveArgDict ''T
deriveArgDict ''S
#else
instance ShowTag T Identity where
    showTaggedPrec UDP = showsPrec
    showTaggedPrec TCP = showsPrec
instance ShowTag S Identity where
    showTaggedPrec SessionUDP = showsPrec
    showTaggedPrec SessionTCP = 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 T A -> Either String (DSum T Identity )
nodeInfo nid (UDP :=> AddrUDP saddr      ) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
nodeInfo nid (TCP :=> AddrTCP conid relay) = Right $ TCP ==> ViaRelay conid nid relay

nodeAddr :: DSum T Identity -> DSum T A
nodeAddr (UDP :=> Identity ni                    ) = UDP :=> AddrUDP (UDP.nodeAddr ni)
nodeAddr (TCP :=> Identity (ViaRelay conid _ relay)) = TCP :=> AddrTCP conid relay
-}

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 doesn't match."

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