Ability to send onion messages when given a path.

5 files changed, 153 insertions, 80 deletions

diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index d467d302..0fa1a05a 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -74,23 +74,21 @@ layerTransport parse encode tr =
 -- | Paritions a 'Transport' into two higher-level transports.  Note: An 'MVar'
 -- is used to share the same underlying socket, so be sure to fork a thread for
 -- both returned 'Transport's to avoid hanging.
-partitionTransport :: ((b,a) -> Either (x,xaddr) (y,yaddr))
-                      -> ((x,xaddr) -> (b,a))
-                      -> ((y,yaddr) -> (b,a))
+partitionTransport :: ((b,a) -> Either (x,xaddr) (b,a))
+                      -> ((x,xaddr) -> Maybe (b,a))
                       -> Transport err a b
-                      -> IO (Transport err xaddr x, Transport err yaddr y)
-partitionTransport parse encodex encodey tr =
-    partitionTransportM (return . parse) (return . encodex) (return . encodey) tr
+                      -> IO (Transport err xaddr x, Transport err a b)
+partitionTransport parse encodex tr =
+    partitionTransportM (return . parse) (return . encodex) tr
 
 -- | Paritions a 'Transport' into two higher-level transports.  Note: An 'MVar'
 -- is used to share the same underlying socket, so be sure to fork a thread for
 -- both returned 'Transport's to avoid hanging.
-partitionTransportM :: ((b,a) -> IO (Either (x,xaddr) (y,yaddr)))
-                      -> ((x,xaddr) -> IO (b,a))
-                      -> ((y,yaddr) -> IO (b,a))
+partitionTransportM :: ((b,a) -> IO (Either (x,xaddr) (b,a)))
+                      -> ((x,xaddr) -> IO (Maybe (b,a)))
                       -> Transport err a b
-                      -> IO (Transport err xaddr x, Transport err yaddr y)
-partitionTransportM parse encodex encodey tr = do
+                      -> IO (Transport err xaddr x, Transport err a b)
+partitionTransportM parse encodex tr = do
     mvar <- newEmptyMVar
     let xtr = tr { awaitMessage = \kont -> fix $ \again -> do
                     awaitMessage tr $ \m -> case m of
@@ -100,14 +98,12 @@ partitionTransportM parse encodex encodey tr = do
                         Just (Left e)    -> kont $ Just (Left e)
                         Nothing          -> kont Nothing
                  , sendMessage = \addr' msg' -> do
-                    (msg,addr) <- encodex (msg',addr')
-                    sendMessage tr addr msg
+                    msg_addr <- encodex (msg',addr')
+                    mapM_ (uncurry . flip $ sendMessage tr) msg_addr
                  }
         ytr = Transport
                 { awaitMessage = \kont -> takeMVar mvar >>= kont . Just . Right
-                , sendMessage = \addr' msg' -> do
-                    (msg,addr) <- encodey (msg',addr')
-                    sendMessage tr addr msg
+                , sendMessage = sendMessage tr
                 , closeTransport = return ()
                 }
     return (xtr, ytr)
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 8df1a09d..3c5fc955 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -192,7 +192,7 @@ newClient drg net classify selfAddr handlers modifynet = do
 
 data Tox = Tox
     { toxDHT :: DHT.Client
-    , toxOnion :: Onion.Client
+    , toxOnion :: Onion.Client RouteId
     , toxCrypto :: Transport String SockAddr NetCrypto
     , toxRouting :: DHT.Routing
     , toxTokens :: TVar SessionTokens
@@ -237,7 +237,10 @@ newTox keydb addr = do
     oniondrg <- drgNew
     let onionnet = layerTransport (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
     onionclient <- newClient oniondrg onionnet Onion.classify
-                    (const $ return $ either (const $ error "bad sockaddr") Onion.OnionDestination $ nodeInfo zeroID addr)
+                    (const $ return
+                           $ either (const $ error "bad sockaddr")
+                                    (flip Onion.OnionDestination Nothing)
+                           $ nodeInfo zeroID addr)
                     (Onion.handlers onionnet routing toks keydb)
                     (const id)
     return Tox
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 72398735..08f5cabd 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -35,7 +35,7 @@ import Data.Bits
 import Data.Ord
 import Data.Functor.Identity
 
-type Client = QR.Client String PacketKind TransactionId OnionDestination Message
+type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message
 type Message = OnionMessage Identity
 
 classify :: Message -> MessageClass String PacketKind TransactionId
@@ -59,7 +59,7 @@ classify msg = go msg
 -- The reason for this 20 second timeout in toxcore is that it gives a reasonable
 -- time (20 to 40 seconds) for a peer to announce himself while taking in count
 -- all the possible delays with some extra seconds.
-announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination -> AnnounceRequest -> IO AnnounceResponse
+announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination r -> AnnounceRequest -> IO AnnounceResponse
 announceH routing toks keydb (OnionToOwner naddr retpath) req = do
     case () of
         _ | announcePingId req == zeros32
@@ -76,7 +76,7 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do
         let storing = (nodeId naddr == announceSeeking req)
         record <- atomically $ do
             when (withTok && storing) $ do
-                let toxpath = OnionToOwner naddr{ nodeId = announceKey req } retpath
+                let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath
                     -- Note: The following distance calculation assumes that
                     -- our nodeid doesn't change and is the same for both
                     -- routing4 and routing6.
@@ -89,16 +89,16 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do
                     then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr
                     else return $ zeros32
         let k = case record of
-                Nothing                              -> NotStored newtok
-                Just (OnionDestination {}) | storing -> Acknowledged newtok
-                Just (OnionToOwner   ni _)           -> SendBackKey $ id2key (nodeId ni)
+                Nothing                    -> NotStored newtok
+                Just _  | storing          -> Acknowledged newtok
+                Just (AnnouncedRoute ni _) -> SendBackKey $ id2key (nodeId ni)
         let response = AnnounceResponse k ns
         hPutStrLn stderr $ unwords ["Announce:", show req, "-reply->", show response]
         return response
 
 dataToRouteH ::
           TVar AnnouncedKeys
-          -> Transport err OnionDestination (OnionMessage f)
+          -> Transport err (OnionDestination r) (OnionMessage f)
           -> addr
           -> OnionMessage f
           -> IO ()
@@ -111,18 +111,23 @@ dataToRouteH keydb udp _ (OnionToRoute pub assym) = do
             return rpath
     forM_ mb $ \rpath -> do
         -- forward
-        sendMessage udp rpath $ OnionToRouteResponse assym
+        sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse assym
         hPutStrLn stderr $ "Forwarding data-to-route -->"++show k
 
 type NodeDistance = NodeId
 
+data AnnouncedRoute = AnnouncedRoute NodeInfo (ReturnPath N3)
+
+toOnionDestination :: AnnouncedRoute -> OnionDestination r
+toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath
+
 data AnnouncedKeys = AnnouncedKeys
     { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds
-    , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,OnionDestination))
+    , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,AnnouncedRoute))
     }
 
 
-insertKey :: POSIXTime -> NodeId -> OnionDestination -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys
+insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys
 insertKey tm pub toxpath d keydb = AnnouncedKeys
     { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb)
     , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of
@@ -134,12 +139,12 @@ areq :: Message -> Either String AnnounceRequest
 areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym
 areq _                     = Left "Unexpected non-announce OnionMessage"
 
-handlers :: Transport err OnionDestination Message
+handlers :: Transport err (OnionDestination r) Message
             -> Routing
             -> TVar SessionTokens
             -> TVar AnnouncedKeys
             -> PacketKind
-            -> Maybe (MethodHandler String TransactionId OnionDestination Message)
+            -> Maybe (MethodHandler String TransactionId (OnionDestination r) Message)
 handlers net routing toks keydb AnnounceType
     = Just
     $ MethodHandler areq (\(TransactionId n8 n24) src dst -> OnionAnnounceResponse n8 n24 . Identity)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 0e6e4954..a3c1950f 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -33,6 +33,8 @@ module Network.Tox.Onion.Transport
     , encrypt
     , decrypt
     , peelSymmetric
+    , OnionRoute(..)
+    , N3
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -86,13 +88,14 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8))
                   , Show (f DataToRoute)
                   ) => Show (OnionMessage f)
 
-data OnionDestination = OnionToOwner NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us.
-                      | OnionDestination NodeInfo             -- ^ Our own onion-path.
+data OnionDestination r
+    = OnionToOwner     NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us.
+    | OnionDestination NodeInfo (Maybe r)       -- ^ Our own onion-path.
     deriving Show
 
-onionKey :: OnionDestination -> Maybe PublicKey
-onionKey (OnionToOwner ni _) = Just $ id2key (nodeId ni)
-onionKey _                   = Nothing
+onionKey :: OnionDestination r -> Maybe PublicKey
+onionKey (OnionToOwner     ni _) = Just $ id2key (nodeId ni)
+onionKey (OnionDestination ni _) = Just $ id2key (nodeId ni)
 
 instance Sized (OnionMessage Encrypted) where
     size = VarSize $ \case
@@ -111,15 +114,14 @@ instance Serialize (OnionMessage Encrypted) where
         case typ :: Word8 of
             0x83 -> OnionAnnounce <$> getAliasedAssym
             0x85 -> OnionToRoute <$> getPublicKey <*> getAliasedAssym
-            0x84 -> getOnionReply typ
-            0x86 -> getOnionReply typ
-            t    -> fail $ "Unknown onion payload: " ++ show t
+            t    -> fail ("Unknown onion payload: " ++ show t)
+                    `fromMaybe` getOnionReply t
     put (OnionAnnounce a)                = putWord8 0x83 >> putAliasedAssym a
     put (OnionToRoute k a)               = putWord8 0x85 >> putPublicKey k >> putAliasedAssym a
     put (OnionAnnounceResponse n8 n24 x) = putWord8 0x84 >> put n8 >> put n24 >> put x
     put (OnionToRouteResponse a)         = putWord8 0x86 >> putAliasedAssym a
 
-onionToOwner :: Assym a -> ReturnPath N3 -> SockAddr -> Either String OnionDestination
+onionToOwner :: Assym a -> ReturnPath N3 -> SockAddr -> Either String (OnionDestination r)
 onionToOwner assym ret3 saddr = do
     ni <- nodeInfo (key2id $ senderKey assym) saddr
     return $ OnionToOwner ni ret3
@@ -130,36 +132,37 @@ onion :: Sized msg =>
                ByteString
                -> SockAddr
                -> Get (Assym (Encrypted msg) -> t)
-               -> Either String (t, OnionDestination)
+               -> Either String (t, OnionDestination r)
 onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
                          oaddr <- onionToOwner assym ret3 saddr
                          return (f assym, oaddr)
 
-
-parseOnionAddr :: (ByteString, SockAddr) -> Either (OnionMessage Encrypted,OnionDestination) (ByteString,SockAddr)
-parseOnionAddr (msg,saddr)
+parseOnionAddr :: (SockAddr -> Nonce8 -> IO (Maybe (NodeInfo,r)))
+                  -> (ByteString, SockAddr)
+                  -> IO (Either (OnionMessage Encrypted,OnionDestination r)
+                                (ByteString,SockAddr))
+parseOnionAddr lookupSender (msg,saddr)
     | Just (typ,bs) <- B.uncons msg
     , let right = Right (msg,saddr)
-          query = either (const right) Left
-          response = either (const right) (Left . \msg -> ( msg , replyAlias saddr msg ))
+          query = return . either (const right) Left
     = case typ of
     0x83 -> query $ onion bs saddr (pure OnionAnnounce)            -- Announce Request
     0x85 -> query $ onion bs saddr (OnionToRoute <$> getPublicKey) -- Onion Data Request
-    0x84 -> response $ runGet (getOnionReply 0x84) bs              -- Announce Response
-    0x86 -> response $ runGet (getOnionReply 0x86) bs              -- Onion Data Response
-    _ -> right
-
-getOnionReply :: Word8 -> Get (OnionMessage Encrypted)
-getOnionReply 0x84 = OnionAnnounceResponse <$> get <*> get <*> get
-getOnionReply 0x86 = OnionToRouteResponse <$> getOnionAssym
-
-replyAlias :: SockAddr -> OnionMessage Encrypted -> OnionDestination
-replyAlias saddr (OnionAnnounceResponse  _ _ _)
-    = OnionDestination
-    $ either (error "replyAlias: bad protocol") id
-    $ nodeInfo zeroID saddr -- TODO OnionAnnounceResponse has no sender key
-replyAlias saddr (OnionToRouteResponse asym)
-    = OnionDestination $ asymNodeInfo saddr asym
+    _ -> case flip runGet bs <$> getOnionReply typ of
+            Just (Right msg@(OnionAnnounceResponse n8 _ _)) -> do
+                maddr <- lookupSender saddr n8
+                maybe (return right) -- Response unsolicited or too late.
+                      (return . Left . \(ni,r) -> (msg,OnionDestination ni (Just r)))
+                      maddr
+            Just (Right msg@(OnionToRouteResponse asym)) -> do
+                let ni = asymNodeInfo saddr asym
+                return $ Left (msg, OnionDestination ni Nothing)
+            _ -> return right
+
+getOnionReply :: Word8 -> Maybe (Get (OnionMessage Encrypted))
+getOnionReply 0x84 = Just $ OnionAnnounceResponse <$> get <*> get <*> get
+getOnionReply 0x86 = Just $ OnionToRouteResponse <$> getOnionAssym
+getOnionReply _    = Nothing
 
 putOnionMsg :: OnionMessage Encrypted -> Put
 putOnionMsg (OnionAnnounce                a) = putOnionAssym 0x83 (return ()) a
@@ -167,10 +170,18 @@ putOnionMsg (OnionToRoute pubkey          a) = putOnionAssym 0x85 (putPublicKey
 putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
 putOnionMsg (OnionToRouteResponse         a) = putOnionAssym 0x86 (return ()) a
 
-encodeOnionAddr :: (OnionMessage Encrypted,OnionDestination) -> (ByteString, SockAddr)
-encodeOnionAddr (msg,OnionToOwner ni p) = ( runPut $ putResponse (OnionResponse p msg)
-                                          , nodeAddr ni )
-encodeOnionAddr (msg,OnionDestination a) = ( runPut (putOnionMsg msg), nodeAddr a) -- TODO: Construct (OnionRequest N0)?
+encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute))
+                   -> (OnionMessage Encrypted,OnionDestination r)
+                   -> IO (Maybe (ByteString, SockAddr))
+encodeOnionAddr _ (msg,OnionToOwner ni p) =
+    return $ Just ( runPut $ putResponse (OnionResponse p msg)
+                  , nodeAddr ni )
+encodeOnionAddr _        (msg,OnionDestination _  Nothing   ) = return Nothing
+encodeOnionAddr getRoute (msg,OnionDestination ni (Just rid)) = do
+    let go route = do
+            return (runPut $ putRequest $ wrapForRoute msg ni route, nodeAddr ni)
+    getRoute ni rid >>= mapM go
+
 
 forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport
 forwardOnions crypto udp = udp { awaitMessage = forwardAwait crypto udp }
@@ -253,7 +264,8 @@ data OnionResponse n = OnionResponse
 deriving instance KnownNat (PeanoNat n) => Show (OnionResponse n)
 
 instance ( Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where
-    get = OnionResponse <$> get <*> (get >>= getOnionReply)
+    get = OnionResponse <$> get <*> (get >>= fromMaybe (fail "illegal onion forwarding")
+                                             . getOnionReply)
     put (OnionResponse p m) = put p >> putOnionMsg m
 
 
@@ -525,7 +537,7 @@ instance Sized OnionData where
                              -- should be treated as variable sized.
             VarSize f   -> f dhtpk
 
-encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination -> (OnionMessage Encrypted, OnionDestination)
+encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> (OnionMessage Encrypted, OnionDestination r)
 encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData))
                                          . encryptMessage skey okey)
                                        msg
@@ -545,31 +557,78 @@ encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
     secret = computeSharedSecret skey destKey n
     plain  = encodePlain a
 
-decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination -> Either String (OnionMessage Identity, OnionDestination)
-decrypt crypto msg addr = (, addr) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg)
+decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> Either String (OnionMessage Identity, OnionDestination r)
+decrypt crypto msg addr = do
+    msg <- sequenceMessage $ transcode (\n -> decryptMessage crypto n . left (senderkey addr)) msg
+    Right (msg, addr)
+
+senderkey :: OnionDestination r -> t -> (Maybe PublicKey, t)
+senderkey addr e = (onionKey addr, e)
 
 decryptMessage :: Serialize x =>
                   TransportCrypto
                   -> Nonce24
-                  -> Either (Encrypted x) (Assym (Encrypted x))
+                  -> Either (Maybe PublicKey, Encrypted x)
+                            (Assym (Encrypted x))
                   -> (Either String ∘ Identity) x
-decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e
+decryptMessage crypto n arg
+    | Just secret <- msecret = plain $ ToxCrypto.decrypt secret e
+    | otherwise              = Composed $ Left "decryptMessage: Unknown sender"
  where
-    secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n
-    e      = assymData assymE
-    plain  = Composed . fmap Identity . (>>= decodePlain)
-decryptMessage crypto n (Left e) = _todo -- OnionAnnounceResponse has no sender key
+    msecret  = do sender <- mkey
+                  Just $ computeSharedSecret (transportSecret crypto) sender n
+    (mkey,e) = either id (Just . senderKey &&& assymData) arg
+    plain    = Composed . fmap Identity . (>>= decodePlain)
 
 
 sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f)
-sequenceMessage (OnionAnnounce a)        = fmap OnionAnnounce        $ sequenceA $ fmap uncomposed a
+sequenceMessage (OnionAnnounce a)        = fmap OnionAnnounce $ sequenceA $ fmap uncomposed a
 sequenceMessage (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 <$> uncomposed dta
 sequenceMessage (OnionToRoute pub a)     = pure $ OnionToRoute pub a
 sequenceMessage (OnionToRouteResponse a) = pure $ OnionToRouteResponse a
 
 transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> OnionMessage f -> OnionMessage g
-transcode f (OnionAnnounce a)        = OnionAnnounce        $ a { assymData = f (assymNonce a) (Right a) }
+transcode f (OnionAnnounce a)        = OnionAnnounce $ a { assymData = f (assymNonce a) (Right a) }
 transcode f (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 $ f n24 $ Left dta
 transcode f (OnionToRoute pub a)     = OnionToRoute pub     a
 transcode f (OnionToRouteResponse a) = OnionToRouteResponse a
 
+
+data OnionRoute = OnionRoute
+    { routeNonce  :: Nonce24
+    , routeAliasA :: SecretKey
+    , routeAliasB :: SecretKey
+    , routeAliasC :: SecretKey
+    , routeNodeA  :: NodeInfo
+    , routeNodeB  :: NodeInfo
+    , routeNodeC  :: NodeInfo
+    }
+
+wrapForRoute :: OnionMessage Encrypted -> NodeInfo -> OnionRoute -> OnionRequest N0
+wrapForRoute msg ni r = OnionRequest
+    { onionNonce = routeNonce r
+    , onionForward = wrapOnion (routeAliasA r)
+                               (routeNonce r)
+                               (id2key . nodeId $ routeNodeA r)
+                               (nodeAddr $ routeNodeB r)
+                   $ wrapOnion (routeAliasB r)
+                               (routeNonce r)
+                               (id2key . nodeId $ routeNodeB r)
+                               (nodeAddr $ routeNodeC r)
+                   $ wrapOnion (routeAliasC r)
+                               (routeNonce r)
+                               (id2key . nodeId $ routeNodeC r)
+                               (nodeAddr ni)
+                   $ NotForwarded msg
+    , pathFromOwner = NoReturnPath
+    }
+
+wrapOnion :: Serialize (Forwarding n msg) =>
+           SecretKey
+           -> Nonce24
+           -> PublicKey
+           -> SockAddr
+           -> Forwarding n msg
+           -> Forwarding (S n) msg
+wrapOnion skey nonce destkey saddr fwd =
+    Forwarding (toPublic skey) $ encryptMessage skey destkey nonce (Addressed saddr fwd)
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index d99b6713..d441dc0a 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeOperators              #-}
-module Network.Tox.Transport (toxTransport) where
+module Network.Tox.Transport (toxTransport, RouteId) where
 
 import Network.QueryResponse
 import Crypto.Tox
@@ -16,16 +16,26 @@ import Network.Tox.Crypto.Transport
 
 import Network.Socket
 
+type RouteId = () -- todo
+
+lookupSender :: SockAddr -> Nonce8 -> IO (Maybe (NodeInfo, RouteId))
+lookupSender _ _ = return Nothing -- todo
+
+lookupRoute :: NodeInfo -> RouteId -> IO (Maybe OnionRoute)
+lookupRoute _ _ = return Nothing -- todo
+
 toxTransport ::
       TransportCrypto
           -> (PublicKey -> IO (Maybe NodeInfo))
           -> UDPTransport
           -> IO ( Transport String NodeInfo (DHTMessage Encrypted8)
-                , Transport String OnionDestination (OnionMessage Encrypted)
+                , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                 , Transport String SockAddr NetCrypto )
 toxTransport crypto closeLookup udp = do
-    (dht,udp1) <- partitionTransport parseDHTAddr encodeDHTAddr id $ forwardOnions crypto udp
-    (onion,udp2) <- partitionTransport parseOnionAddr encodeOnionAddr id udp1
+    (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp
+    (onion,udp2) <- partitionTransportM (parseOnionAddr lookupSender)
+                                        (encodeOnionAddr lookupRoute)
+                                        udp1
     let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2
     return ( forwardDHTRequests crypto closeLookup dht
            , onion