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