Used partitionTransform to simplify the onion client.

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)
 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 (either4or6)
 import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_)
@@ -64,25 +65,40 @@ 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 ==> 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
+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
@@ -90,6 +106,9 @@ instance ShowTag T Identity where
 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 = (==)
@@ -99,16 +118,6 @@ instance OrdTag S Identity where
 #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 _)) =