summaryrefslogtreecommitdiff
path: root/dht/src/Data/Tox/DHT/Multi.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src/Data/Tox/DHT/Multi.hs')
-rw-r--r--dht/src/Data/Tox/DHT/Multi.hs45
1 files changed, 27 insertions, 18 deletions
diff --git a/dht/src/Data/Tox/DHT/Multi.hs b/dht/src/Data/Tox/DHT/Multi.hs
index f769e384..7c8804b5 100644
--- a/dht/src/Data/Tox/DHT/Multi.hs
+++ b/dht/src/Data/Tox/DHT/Multi.hs
@@ -11,6 +11,7 @@ import Crypto.PubKey.Curve25519 (PublicKey)
11import qualified Network.Tox.NodeId as UDP 11import qualified Network.Tox.NodeId as UDP
12 ;import Network.Tox.NodeId (NodeId) 12 ;import Network.Tox.NodeId (NodeId)
13import qualified Network.Tox.TCP.NodeId as TCP 13import qualified Network.Tox.TCP.NodeId as TCP
14import Data.Tox.Onion (OnionDestination,RouteId)
14import Data.Tox.Relay hiding (NodeInfo) 15import Data.Tox.Relay hiding (NodeInfo)
15import Network.Address (either4or6) 16import Network.Address (either4or6)
16import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) 17import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_)
@@ -64,25 +65,40 @@ instance GShow S where
64 gshowsPrec _ SessionUDP = showString "UDP" 65 gshowsPrec _ SessionUDP = showString "UDP"
65 gshowsPrec _ SessionTCP = showString "TCP" 66 gshowsPrec _ SessionTCP = showString "TCP"
66 67
68data O addr where
69 OnionUDP :: O (OnionDestination RouteId)
70 OnionTCP :: O (OnionDestination RouteId)
71
72instance GEq O where
73 geq OnionUDP OnionUDP = Just Refl
74 geq OnionTCP OnionTCP = Just Refl
75 geq _ _ = Nothing
76instance GCompare O where
77 gcompare OnionUDP OnionUDP = GEQ
78 gcompare OnionUDP OnionTCP = GLT
79 gcompare OnionTCP OnionTCP = GEQ
80 gcompare OnionTCP OnionUDP = GGT
81instance GShow O where
82 gshowsPrec _ OnionUDP = showString "UDP"
83 gshowsPrec _ OnionTCP = showString "TCP"
84
85untagOnion :: DSum O Identity -> OnionDestination RouteId
86untagOnion (OnionUDP :=> Identity o) = o
87untagOnion (OnionTCP :=> Identity o) = o
88
67-- Canonical in case of 6-mapped-4 addresses. 89-- Canonical in case of 6-mapped-4 addresses.
68canonize :: DSum S Identity -> DSum S Identity 90canonize :: DSum S Identity -> DSum S Identity
69canonize (SessionUDP :=> Identity saddr) = SessionUDP ==> either id id (either4or6 saddr) 91canonize (SessionUDP :=> Identity saddr) = SessionUDP ==> either id id (either4or6 saddr)
70canonize taddr = taddr 92canonize taddr = taddr
71 93
72data A addr where
73 AddrUDP :: SockAddr -> A UDP.NodeInfo
74 AddrTCP :: Maybe ConId -> TCP.NodeInfo -> A TCP.ViaRelay
75
76deriving instance Eq (A addr)
77
78type NodeInfo = DSum T Identity 94type NodeInfo = DSum T Identity
79type SessionAddress = DSum S Identity 95type SessionAddress = DSum S Identity
80 96type OnionAddress = DSum O Identity
81type Address = DSum T A
82 97
83#if MIN_VERSION_dependent_sum(0,6,0) 98#if MIN_VERSION_dependent_sum(0,6,0)
84deriveArgDict ''T 99deriveArgDict ''T
85deriveArgDict ''S 100deriveArgDict ''S
101deriveArgDict ''O
86#else 102#else
87instance ShowTag T Identity where 103instance ShowTag T Identity where
88 showTaggedPrec UDP = showsPrec 104 showTaggedPrec UDP = showsPrec
@@ -90,6 +106,9 @@ instance ShowTag T Identity where
90instance ShowTag S Identity where 106instance ShowTag S Identity where
91 showTaggedPrec SessionUDP = showsPrec 107 showTaggedPrec SessionUDP = showsPrec
92 showTaggedPrec SessionTCP = showsPrec 108 showTaggedPrec SessionTCP = showsPrec
109instance ShowTag O Identity where
110 showTaggedPrec OnionUDP = showsPrec
111 showTaggedPrec OnionTCP = showsPrec
93instance EqTag S Identity where 112instance EqTag S Identity where
94 eqTagged SessionUDP SessionUDP = (==) 113 eqTagged SessionUDP SessionUDP = (==)
95 eqTagged SessionTCP SessionTCP = (==) 114 eqTagged SessionTCP SessionTCP = (==)
@@ -99,16 +118,6 @@ instance OrdTag S Identity where
99#endif 118#endif
100 119
101 120
102{-
103nodeInfo :: NodeId -> DSum T A -> Either String (DSum T Identity )
104nodeInfo nid (UDP :=> AddrUDP saddr ) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
105nodeInfo nid (TCP :=> AddrTCP conid relay) = Right $ TCP ==> ViaRelay conid nid relay
106
107nodeAddr :: DSum T Identity -> DSum T A
108nodeAddr (UDP :=> Identity ni ) = UDP :=> AddrUDP (UDP.nodeAddr ni)
109nodeAddr (TCP :=> Identity (ViaRelay conid _ relay)) = TCP :=> AddrTCP conid relay
110-}
111
112nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity) 121nodeInfo :: NodeId -> DSum S Identity -> Either String (DSum T Identity)
113nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr 122nodeInfo nid (SessionUDP :=> Identity saddr) = fmap (UDP ==>) $ UDP.nodeInfo nid saddr
114nodeInfo nid (SessionTCP :=> Identity taddr@(ViaRelay _ nid2 _)) = 123nodeInfo nid (SessionTCP :=> Identity taddr@(ViaRelay _ nid2 _)) =