6 files changed, 161 insertions, 115 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)
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 4898513a..60b793af 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -34,6 +34,7 @@ import qualified Data.ByteString              as B
          ;import Data.ByteString              (ByteString)
 import qualified Data.ByteString.Char8        as C8
 import Data.Data
+import qualified Data.Dependent.Map           as DMap
 import Data.Dependent.Sum
 import Data.Functor.Identity
 import Data.Functor.Contravariant
@@ -252,37 +253,6 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do
             _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
     return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
 
-newOnionClient :: DRG g =>
-                        TransportCrypto
-                        -> Transport String (Onion.OnionDestination RouteId) Onion.Message
-                        -> DHT.Routing
-                        -> TVar SessionTokens
-                        -> TVar Onion.AnnouncedKeys
-                        -> OnionRouter
-                        -> TVar (g, Data.Word64Map.Word64Map a)
-                        -> ((Maybe Onion.Message -> IO ()) -> a)
-                        -> (a -> Maybe Onion.Message -> IO void)
-                        -> Client String
-                                  DHT.PacketKind
-                                  DHT.TransactionId
-                                  (Onion.OnionDestination RouteId)
-                                  Onion.Message
-newOnionClient crypto net r toks keydb orouter map_var store load = c
- where
-  eprinter = logErrors
-  c = Client
-    { clientNet = addHandler (reportParseError eprinter) (handleMessage c) net
-    , clientDispatcher = DispatchMethods
-        { classifyInbound = Onion.classify
-        , lookupHandler   = Onion.handlers net r toks keydb
-        , tableMethods = hookQueries orouter DHT.transactionKey
-                         $ transactionMethods' store load (contramap w64Key w64MapMethods) gen
-        }
-    , clientErrorReporter = eprinter
-    , clientPending = map_var
-    , clientAddress = getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 r)
-    , clientResponseId = genNonce24 map_var
-    }
 
 newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rendezvous for.
        -> [String]                   -- ^ Bind-address to listen on. Must provide at least one.
@@ -346,8 +316,8 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
     let lookupClose _ = return Nothing
 
     mkrouting <- DHT.newRouting addr crypto updateIP updateIP
-    (orouter,relaynet,otbl) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp)
-    (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes)
+    (orouter,relaynet,onioncryptTCP) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp)
+    (cryptonet,dhtcrypt,onioncryptUDP,dtacrypt,handshakes)
         <- toxTransport crypto orouter lookupClose addr udp relaynet
                 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x))
                 (fromMaybe (\_ _ -> return ()) tcp)
@@ -378,12 +348,30 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
     toks <- do
         nil <- nullSessionTokens
         atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids.
-    let onionnet = layerTransportM (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
-    let onionclient  = newOnionClient crypto onionnet (mkrouting dhtclient) toks keydb orouter' otbl
-                        Right $ \case
-                            Right v -> v
-                            Left v  -> \_ ->
-                                dput XUnexpected "TCP-sent onion query got response over UDP?"
+
+    onioncrypt <- mergeTransports $ DMap.fromList
+        [ Multi.OnionUDP :=> ByAddress onioncryptUDP
+        , Multi.OnionTCP :=> ByAddress onioncryptTCP ]
+    oniondrg <- drgNew
+    let onionnet = layerTransportM
+                        (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od)
+                        (\msg od -> do
+                            (msg', od') <- Onion.encrypt crypto msg od
+                            -- TODO: lookupRoute is unnecessarily done twice
+                            -- because that was convenient for me.  The other
+                            -- call was done when building the transport.
+                            -- Consider simplifying this.
+                            mtcp <- case od' of
+                               Onion.OnionDestination _ ni (Just rid)
+                                    -> (>>= Onion.routeRelayPort) <$> lookupRoute orouter' ni rid
+                               _    -> return Nothing
+                            return (msg', maybe (Multi.OnionUDP ==> od') (const $ Multi.OnionTCP ==> od') mtcp))
+                        onioncrypt
+    onionclient <- newClient oniondrg onionnet (const Onion.classify)
+                    (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient))
+                    (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb)
+                    (hookQueries orouter' DHT.transactionKey)
+                    (const id)
 
     return Tox
         { toxDHT            = dhtclient
diff --git a/dht/src/Network/Tox/Onion/Routes.hs b/dht/src/Network/Tox/Onion/Routes.hs
index baca693b..b20ad7dd 100644
--- a/dht/src/Network/Tox/Onion/Routes.hs
+++ b/dht/src/Network/Tox/Onion/Routes.hs
@@ -159,9 +159,8 @@ newOnionRouter :: TransportCrypto
                     -> Bool -- is tcp enabled?
                     -> IO ( OnionRouter
                           , Transport String TCP.ViaRelay B.ByteString
-                          , TVar ( ChaChaDRG
-                                 , Word64Map (Either (Maybe (Bool,TCP.RelayPacket) -> IO ())
-                                                     (Maybe (OnionMessage Identity) -> IO ()))))
+                          , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
+                          )
 newOnionRouter crypto perror tcp_enabled = do
     drg0 <- drgNew
     (rlog,pq,rm) <- atomically $ do
@@ -169,26 +168,12 @@ newOnionRouter crypto perror tcp_enabled = do
         pq <- newTVar W64.empty
         rm <- newArray (0,11) Nothing
         return (rlog,pq,rm)
-    ((tbl,(tcptbl,tcpcons,relaynet)),tcp) <- do
-        (tcptbl, client) <- TCP.newClient crypto Left $ \case
-            Left v  -> void . v . Just . (,) False
-            Right v -> \case
-                TCP.OnionPacketResponse x@(OnionAnnounceResponse n8 n24 _) -> do
-                    mod <- lookupSender' pq rlog localhost4 n8
-                    perror $ "TCP announce response from " ++ show mod
-                    forM_ mod $ \od -> do
-                        Onion.decrypt crypto x od >>= \case
-                            Right (y,_) -> do perror $ "decrypted announce response, sending " ++ show y
-                                              let
-                                                RouteId rid = fromMaybe (routeId (nodeId (onionNodeInfo od)))
-                                                                $ onionRouteSpec od
-                                                Nonce8 w8 = n8
-                                              atomically $ do
-                                                modifyTVar' pq (W64.delete w8)
-                                                modifyArray rm (fmap gotResponse) rid
-                                              void $ v $ Just y
-                            _           -> return ()
-                x -> perror $ "Unexpected TCP query result: " ++ show x
+    ((tbl,(tcptbl,tcpcons,relaynet,onionnet)),tcp) <- do
+        (tcptbl, client) <- TCP.newClient crypto
+                                    id
+                                    (. (Just . (,) False))
+                                    (lookupSender' pq rlog)
+                                    (\_ (RouteId rid) -> atomically $ fmap storedRoute <$> readArray rm rid)
 
         let addr = SockAddrInet 0 0
             tentative_udp = NodeInfo
@@ -269,7 +254,7 @@ newOnionRouter crypto perror tcp_enabled = do
                                             $ clientNet c }
                     }
                  }
-    return (or,relaynet,tcptbl)
+    return (or,relaynet,onionnet)
 
 updateTCP :: OnionRouter -> TCP.NodeInfo -> p -> IO ()
 updateTCP or addr x = do
diff --git a/dht/src/Network/Tox/Onion/Transport.hs b/dht/src/Network/Tox/Onion/Transport.hs
index 407cd387..913d339d 100644
--- a/dht/src/Network/Tox/Onion/Transport.hs
+++ b/dht/src/Network/Tox/Onion/Transport.hs
@@ -24,6 +24,7 @@ module Network.Tox.Onion.Transport
     , decrypt
     , peelSymmetric
     , OnionRoute(..)
+    , dummyRoute
     , N0
     , N1
     , N2
@@ -39,9 +40,11 @@ module Network.Tox.Onion.Transport
     , wrapOnion
     , wrapOnionPure
     , unwrapAnnounceResponse
+    , wrapIndirectHops
     ) where
 
-import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+         ;import Data.ByteString (ByteString)
 import Data.Maybe
 import Data.Serialize
 import Network.Socket
@@ -50,8 +53,10 @@ import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.TCP.NodeId (udpNodeInfo)
 import qualified Data.Tox.Relay as TCP
 import Data.Tox.Onion
+import Network.Address (nullAddress4)
 import Network.Tox.DHT.Transport (SendNodes(..))
 import Network.Tox.NodeId
+import Network.QueryResponse
 
 {-
 encodeOnionAddr :: TransportCrypto
@@ -88,28 +93,28 @@ wrapForRoute :: TransportCrypto
                       -> NodeInfo
                       -> OnionRoute
                       -> IO (Either TCP.RelayPacket (OnionRequest N0))
-wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort=Nothing} = do
-    -- We needn't use the same nonce value here, but I think it is safe to do so.
-    let nonce = msgNonce msg
-    fwd <-  wrapOnion crypto (routeAliasA r)
-                             nonce
-                             (id2key . nodeId $ routeNodeA r)
-                             (nodeAddr $ routeNodeB r)
-        =<< wrapOnion crypto (routeAliasB r)
-                             nonce
-                             (id2key . nodeId $ routeNodeB r)
-                             (nodeAddr $ routeNodeC r)
-        =<< wrapOnion crypto (routeAliasC r)
-                             nonce
-                             (id2key . nodeId $ routeNodeC r)
-                             (nodeAddr ni)
-                             (NotForwarded msg)
-    return $ Right OnionRequest
-        { onionNonce    = nonce
-        , onionForward  = fwd
-        , pathFromOwner = NoReturnPath
-        }
-wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort = Just tcpport} = do
+wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort=Nothing} =
+    wrapIndirectHops crypto msg ni r $ \nonce saddr msg' -> do
+        fwd <- wrapOnion crypto (routeAliasA r)
+                                nonce
+                                (id2key . nodeId $ routeNodeA r)
+                                saddr
+                                msg'
+        return $ Right OnionRequest { onionNonce    = nonce
+                                    , onionForward  = fwd
+                                    , pathFromOwner = NoReturnPath
+                                    }
+wrapForRoute crypto msg ni r@OnionRoute { routeRelayPort = Just _ } =
+    wrapIndirectHops crypto msg ni r $ \nonce saddr fwd ->
+        return $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd
+
+wrapIndirectHops :: TransportCrypto
+                      -> OnionMessage Encrypted
+                      -> NodeInfo
+                      -> OnionRoute
+                      -> (Nonce24 -> SockAddr -> Forwarding N2 (OnionMessage Encrypted) -> IO a)
+                      -> IO a
+wrapIndirectHops crypto msg ni r fin = do
     let nonce = msgNonce msg
     fwd <- wrapOnion crypto (routeAliasB r)
                              nonce
@@ -120,7 +125,7 @@ wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort = Just tcpport} = do
                              (id2key . nodeId $ routeNodeC r)
                              (nodeAddr ni)
                              (NotForwarded msg)
-    return $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd
+    fin nonce (nodeAddr $ routeNodeB r) fwd
 
 unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
 unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index c4727a20..04119164 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -43,7 +43,7 @@ import Data.Tox.Relay
 import qualified Data.Word64Map
 import DebugTag
 import DPut
-import Network.Address (setPort,PortNumber,localhost4,fromSockAddr)
+import Network.Address (setPort,PortNumber,localhost4,fromSockAddr,nullAddress4)
 import Network.Kademlia.Routing
 import Network.Kademlia.Search hiding (sendQuery)
 import Network.QueryResponse
@@ -319,21 +319,25 @@ type RelayCache = TCPCache (SessionProtocol (SessionData,RelayPacket) RelayPacke
 -- defaults are 'id' and 'tryPutMVar'.  The resulting customized table state
 -- will be returned to the caller along with the new client.
 newClient :: TransportCrypto
-               -> ((Maybe (Bool,RelayPacket) -> IO ()) -> a) -- ^ store mvar for query
-               -> (a -> RelayPacket -> IO void)  -- ^ load mvar for query
+               -> ((Maybe (Bool,RelayPacket) -> IO ()) -> a)                    -- ^ store mvar for relay query
+               -> (a -> RelayPacket -> IO void)                                 -- ^ load mvar for relay query
+               -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))) -- ^ lookup sender of onion query
+               -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute))            -- ^ lookup OnionRoute by id
                -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a)
                        , RelayCache
-                       , Transport String ViaRelay ByteString )
+                       , Transport String ViaRelay ByteString
+                       , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) )
                      , Client String PacketNumber Nonce8 NodeInfo (Bool,RelayPacket))
-newClient crypto store load = do
+newClient crypto store load lookupSender getRoute = do
     (tcpcache,net0) <- toxTCP crypto
     (relaynet,net1) <- partitionRelay net0
-    let net2 = {- XXX: Client type forces this pointless layering. -}
-               layerTransport ((Right .) . (,) . (,) False . snd) (,) net1
+    (onionnet,net2) <- partitionOnion crypto lookupSender getRoute net1
+    let net3 = {- XXX: Client type forces this pointless layering. -}
+               layerTransport ((Right .) . (,) . (,) False . snd) (,) net2
     drg <- drgNew
     map_var <- atomically $ newTVar (drg, Data.Word64Map.empty)
-    return $ (,) (map_var,tcpcache,relaynet) Client
-        { clientNet = net2
+    return $ (,) (map_var,tcpcache,relaynet,onionnet) Client
+        { clientNet = net3
         , clientDispatcher = DispatchMethods
             { classifyInbound = (. snd) $ \case
                 RelayPing n             -> IsQuery PingPacket n
@@ -393,3 +397,41 @@ partitionRelay tr = partitionTransportM parse encode tr
     encode :: (ByteString, ViaRelay) -> IO (Maybe ((Bool,RelayPacket), NodeInfo))
     encode (bs, ViaRelay (Just conid) _ ni) = return $ Just ((False,RelayData bs conid), ni)
     encode (bs, ViaRelay Nothing    nid ni) = return $ Just ((False,OOBSend (UDP.id2key nid) bs), ni)
+
+
+partitionOnion :: TransportCrypto
+                  -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId)))
+                  -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute))
+                  -> TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket)
+                  -> IO ( Transport err (OnionDestination RouteId) (OnionMessage Encrypted)
+                        , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket))
+partitionOnion crypto lookupSender getRoute tr = partitionTransportM parse encode tr
+ where
+    parse :: ((SessionData,RelayPacket), NodeInfo)
+                -> IO (Either (OnionMessage Encrypted   , OnionDestination RouteId)
+                              ((SessionData,RelayPacket), NodeInfo))
+    parse pass@((_,OnionPacketResponse msg@(OnionAnnounceResponse n8 _ _)), nodeA) = do
+        m <- lookupSender (nodeAddr nodeA) n8
+        case m of
+            Nothing -> return $ Right pass
+            Just od -> return $ Left (msg, od)
+    parse ((_,OnionPacketResponse msg@(OnionToRouteResponse asym)), nodeA) =
+        return $
+            let Right ni = UDP.nodeInfo (UDP.key2id $ senderKey asym) nullAddress4
+                -- -- We have this information, but currently, we're discarding it...
+                -- r = dummyRoute { routeNodeA     = udpNodeInfo nodeA
+                --                , routeRelayPort = Just $ tcpPort nodeA }
+                tryAllKeys = SearchingAlias -- We unfortunately don't know what toxid was used to encrypt this.
+                                            -- Toxcore only supports a single toxid per DHT node and in that case,
+                                            -- it is unambiguous.
+            in Left (msg, OnionDestination tryAllKeys ni Nothing)
+    parse pass = return $ Right pass
+
+    encode :: (OnionMessage Encrypted,OnionDestination RouteId) -> IO (Maybe ((Bool,RelayPacket),NodeInfo))
+    encode (msg,OnionDestination _ ni (Just rid)) = do
+        moroute <- getRoute ni rid
+        forM (moroute >>= \r -> (,) r <$> routeRelayPort r) $ \(oroute,tcpport) ->
+            wrapIndirectHops crypto msg ni oroute $ \nonce saddr fwd ->
+                return ( (True,OnionPacket nonce $ Addressed saddr fwd)
+                       , NodeInfo (routeNodeA oroute) tcpport )
+    encode _ = return Nothing