Used partitionTransform to simplify the onion client.

2 files changed, 45 insertions, 19 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 _)) =
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index a9bc4e1d..55e81069 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -19,7 +19,7 @@
 module Data.Tox.Onion where
 
 
-import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6)
+import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6,nullAddress4)
 import Network.QueryResponse
 import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.NodeId
@@ -873,6 +873,19 @@ data OnionRoute = OnionRoute
     }
  deriving Show
 
+dummySecret :: SecretKey
+dummySecret = fromJust $ decodeSecret "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+
+dummyNodeId :: NodeId
+dummyNodeId = read "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+
+dummyNode :: NodeInfo
+dummyNode = k where Right k = nodeInfo dummyNodeId nullAddress4
+
+dummyRoute :: OnionRoute
+dummyRoute = OnionRoute dummySecret dummySecret dummySecret
+                        dummyNode dummyNode dummyNode
+                        Nothing
 
 wrapOnion :: Serialize (Forwarding n msg) =>
            TransportCrypto
@@ -956,6 +969,10 @@ instance Read AnnouncedRendezvous where
             }
 
 
+-- | Lookup the secret key for the given toxid public key.  If it is not found,
+-- then the SearchingAlias symbol will be used to indicate that a new temporary
+-- key pair should be generated or that all known keys should be tried until one
+-- succeeds to decrypt the message.
 selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
 selectAlias crypto pkey = do
         ks <- filter (\(sk,pk) -> pk == id2key pkey)