Adapted computeSharedSecret to a side-effecting interface.

This is to ready the tree for a memoizing cache of shared secrets.

6 files changed, 147 insertions, 103 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 307a5db5..37725aea 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -29,7 +29,8 @@ module Crypto.Tox
     , Plain
     , encodePlain
     , decodePlain
-    , computeSharedSecret
+    -- , computeSharedSecret
+    , lookupSharedSecret
     , encrypt
     , decrypt
     , Nonce8(..)
@@ -98,6 +99,8 @@ newtype Encrypted8 a = E8 (Encrypted (a,Nonce8))
 
 newtype (f ∘ g) x = Composed { uncomposed :: f (g x) }
 
+infixr ∘
+
 newtype Auth = Auth Poly1305.Auth deriving (Eq, ByteArrayAccess)
 instance Ord Auth where
     compare (Auth a) (Auth b) = comparing (BA.convert :: Poly1305.Auth -> Bytes) a b
@@ -246,6 +249,11 @@ computeSharedSecret sk recipient nonce = State hash crypt
     -- Since rs is 32 bytes, this pattern should never fail...
     Cryptonite.CryptoPassed hash = Poly1305.initialize rs
 
+lookupSharedSecret :: TransportCrypto -> SecretKey -> PublicKey -> Nonce24 -> IO State
+lookupSharedSecret crypto sk recipient nonce = do
+    -- TODO
+    return $ computeSharedSecret sk recipient nonce
+
 hsalsa20 :: (ByteArrayAccess t, ByteArrayAccess t1) => t1 -> t -> BA.ScrubbedBytes
 hsalsa20 k n = BA.append a b
  where
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 7179e3c2..40d17a07 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -310,7 +310,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
     let ignoreErrors _ = return () -- Set this to (hPutStrLn stderr) to debug onion route building.
     orouter <- newOnionRouter ignoreErrors
     (dhtcrypt,onioncrypt,dtacrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp
-    let dhtnet0 = layerTransport (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
+    let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
     dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr routing) (DHT.handlers crypto routing) id
                     $ \client net -> onInbound (DHT.updateRouting client routing orouter) net
 
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index b8e99d2d..ac3d1ef0 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -94,9 +94,9 @@ freshCryptoSession  sessions
     ncState0 <- atomically $ newTVar Accepted
     ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce
     n24 <- atomically $ transportNewNonce crypto
+    state <- lookupSharedSecret crypto key remoteDhtPublicKey n24
     let myhandshakeData = newHandShakeData crypto hp
         plain = encodePlain myhandshakeData
-        state = computeSharedSecret key remoteDhtPublicKey n24
         encrypted = encrypt state plain
         myhandshake = Handshake { handshakeCookie = otherCookie
                                 , handshakeNonce = n24
@@ -150,14 +150,19 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
     -- Handle Handshake Message
     let crypto = transportCrypto sessions
         allsessions = netCryptoSessions sessions
-        anyRight xs f = foldr1 (<|>) $ map f xs
+        anyRight [] f     = return $ Left "missing key"
+        anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right)
     seckeys <- map fst <$> atomically (readTVar (userKeys crypto))
     symkey <- atomically $ transportSymmetric crypto
     now <- getPOSIXTime
-    let lr = do -- Either Monad
+    lr <- fmap join . sequence $ do -- Either Monad
             (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie)
-            (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie })
-                <- anyRight seckeys $ \key -> (key,) <$> (decodePlain =<< decrypt (computeSharedSecret key remotePubkey nonce24) encrypted)
+            Right $ do -- IO Monad
+            decrypted <- anyRight seckeys $ \key -> do
+                            secret <- lookupSharedSecret crypto key remotePubkey nonce24
+                            return $ (key,) <$> (decodePlain =<< decrypt secret encrypted)
+            return $ do -- Either Monad
+            (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
             -- check cookie time < 15 seconds ago
             guard (now - fromIntegral cookieTime < 15)
             -- cookie hash is valid? sha512 of ecookie
@@ -208,9 +213,11 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
             let diff :: Word16
                 diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16
             tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word
-            let lr = do -- Either Monad --
+            lr <- fmap join $ sequence $ do -- Either Monad --
                         pubkey <- maybeToEither ncTheirSessionPublic
-                        decodePlain =<< decrypt (computeSharedSecret ncSessionSecret pubkey tempNonce) encrypted
+                        Right $ do -- IO Monad
+                        secret <- lookupSharedSecret crypto ncSessionSecret pubkey tempNonce
+                        return $ decodePlain =<< decrypt secret encrypted
             case lr of
                 Left _ -> return Nothing -- decryption failed, ignore packet
                 Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded,
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs
index 736e84d1..bd108276 100644
--- a/src/Network/Tox/DHT/Transport.hs
+++ b/src/Network/Tox/DHT/Transport.hs
@@ -426,34 +426,37 @@ forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' }
                   await' pass
         m -> pass m
 
-encrypt :: TransportCrypto -> DHTMessage ((,) Nonce8) -> NodeInfo -> (DHTMessage Encrypted8, NodeInfo)
-encrypt crypto msg ni = ( transcode (encryptMessage crypto (id2key $ nodeId ni)) msg
-                        , ni )
+encrypt :: TransportCrypto -> DHTMessage ((,) Nonce8) -> NodeInfo -> IO (DHTMessage Encrypted8, NodeInfo)
+encrypt crypto msg ni = do
+    let cipher n plain = Composed $ encryptMessage crypto (id2key $ nodeId ni) n plain
+    m <- sequenceMessage $ transcode cipher msg
+    return (m, ni)
 
 encryptMessage :: Serialize a =>
                   TransportCrypto ->
                   PublicKey ->
-                  Nonce24 -> Either (Nonce8,a) (Asymm (Nonce8,a)) -> Encrypted8 a
-encryptMessage crypto destKey n arg = E8 $ ToxCrypto.encrypt secret plain
- where
-    secret = computeSharedSecret (transportSecret crypto) destKey n
-    plain  = encodePlain $ swap $ either id asymmData arg
+                  Nonce24 -> Either (Nonce8,a) (Asymm (Nonce8,a)) -> IO (Encrypted8 a)
+encryptMessage crypto destKey n arg = do
+    let plain  = encodePlain $ swap $ either id asymmData arg
+    secret <- lookupSharedSecret crypto (transportSecret crypto) destKey n
+    return $ E8 $ ToxCrypto.encrypt secret plain
 
-decrypt :: TransportCrypto -> DHTMessage Encrypted8 -> NodeInfo -> Either String (DHTMessage ((,) Nonce8), NodeInfo)
+decrypt :: TransportCrypto -> DHTMessage Encrypted8 -> NodeInfo -> IO (Either String (DHTMessage ((,) Nonce8), NodeInfo))
 decrypt crypto msg ni = do
-    msg' <- sequenceMessage $ transcode (\n -> decryptMessage crypto n . left ((,) $ id2key $ nodeId ni)) msg
-    return (msg', ni)
+    let decipher n c = Composed $ decryptMessage crypto n . left ((,) $ id2key $ nodeId ni) $ c
+    msg' <- sequenceMessage $ transcode decipher msg
+    return $ fmap (, ni) $ sequenceMessage msg'
 
 decryptMessage :: Serialize x =>
                   TransportCrypto
                   -> Nonce24
                   -> Either (PublicKey, Encrypted8 x) (Asymm (Encrypted8 x))
-                  -> (Either String ∘ ((,) Nonce8)) x
-decryptMessage crypto n arg = plain8 $ ToxCrypto.decrypt secret e
- where
-    secret           = computeSharedSecret (transportSecret crypto) remotekey n
-    (remotekey,E8 e) = either id (senderKey &&& asymmData) arg
-    plain8           = Composed . fmap swap . (>>= decodePlain)
+                  -> IO ((Either String ∘ ((,) Nonce8)) x)
+decryptMessage crypto n arg = do
+    let (remotekey,E8 e) = either id (senderKey &&& asymmData) arg
+        plain8           = Composed . fmap swap . (>>= decodePlain)
+    secret <- lookupSharedSecret crypto (transportSecret crypto) remotekey n
+    return $ plain8 $ ToxCrypto.decrypt secret e
 
 sequenceMessage :: Applicative m => DHTMessage (m ∘ f) -> m (DHTMessage f)
 sequenceMessage (DHTPing asym)              = fmap DHTPing          $ sequenceA $ fmap uncomposed asym
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 5b7aad0b..539e7cee 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -231,19 +231,21 @@ routeId :: NodeId -> RouteId
 routeId nid = RouteId $ mod (hash nid) 12
 
 
-encodeOnionAddr :: (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
+encodeOnionAddr :: TransportCrypto
+                   -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
                    -> (OnionMessage Encrypted,OnionDestination RouteId)
                    -> IO (Maybe (ByteString, SockAddr))
-encodeOnionAddr _ (msg,OnionToOwner ni p) =
+encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
     return $ Just ( runPut $ putResponse (OnionResponse p msg)
                   , nodeAddr ni )
-encodeOnionAddr getRoute (msg,OnionDestination x ni Nothing) = do
-    encodeOnionAddr getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
+encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
+    encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
     -- hPutStrLn stderr $ "ONION encode missing routeid"
     -- return Nothing
-encodeOnionAddr getRoute (msg,OnionDestination _ ni (Just rid)) = do
+encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
-            return ( runPut $ putRequest $ wrapForRoute msg ni route
+            req <- wrapForRoute crypto msg ni route
+            return ( runPut $ putRequest req
                    , nodeAddr $ routeNodeA route)
         mapM' f x = do
             let _ = x :: Maybe OnionRoute
@@ -482,7 +484,8 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) =
     hPutStrLn stderr $ "handleOnionRequest " ++ show n
     (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto
                                       <*> transportNewNonce crypto )
-    case peelOnion crypto nonce msg of
+    peeled <- peelOnion crypto nonce msg
+    case peeled of
         Left e -> do
             -- todo report encryption error
             hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), e]
@@ -505,9 +508,9 @@ peelOnion :: Serialize (Addressed (Forwarding n t))
               => TransportCrypto
               -> Nonce24
               -> Forwarding (S n) t
-              -> Either String (Addressed (Forwarding n t))
-peelOnion crypto nonce (Forwarding k fwd) =
-    fmap runIdentity $ uncomposed $ decryptMessage (dhtKey crypto) nonce (Right $ Asymm k nonce fwd)
+              -> IO (Either String (Addressed (Forwarding n t)))
+peelOnion crypto nonce (Forwarding k fwd) = do
+    fmap runIdentity . uncomposed <$> decryptMessage crypto (dhtKey crypto) nonce (Right $ Asymm k nonce fwd)
 
 handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (ReturnPath n)) => proxy (S n) -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionResponse (S n) -> IO a
 handleOnionResponse proxy crypto saddr udp kont (OnionResponse path msg) = do
@@ -662,27 +665,42 @@ selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _)
                            = return (skey, pkey)
 selectKey crypto msg rpath = return $ aliasKey crypto rpath
 
-encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r)
+encrypt :: TransportCrypto
+                -> OnionMessage Identity
+                -> OnionDestination r
+                -> IO (OnionMessage Encrypted, OnionDestination r)
 encrypt crypto msg rpath = do
     (skey,pkey) <- selectKey crypto msg rpath -- source key
     let okey = onionKey rpath                 -- destination key
-    return ( transcode ( (. (runIdentity . either id asymmData))
-                                         . encryptMessage skey okey)
-                                       msg
-           , rpath)
-
-encryptMessage :: Serialize a =>
-                  SecretKey -> PublicKey -> Nonce24 -> a -> Encrypted a
-encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
- where
-    secret = computeSharedSecret skey destKey n
-    plain  = encodePlain a
+        encipher1 :: Serialize a => SecretKey -> PublicKey -> Nonce24 -> a -> (IO ∘ Encrypted) a
+        encipher1 sk pk n a = Composed $ do
+            secret <- lookupSharedSecret crypto sk pk n
+            return $ ToxCrypto.encrypt secret $ encodePlain a
+        encipher :: Serialize a => Nonce24 -> Either (Identity a) (Asymm (Identity a)) -> (IO ∘ Encrypted) a
+        encipher n d = encipher1 skey okey n $ either runIdentity (runIdentity . asymmData) d
+    m <- sequenceMessage $ transcode encipher msg
+    return (m, rpath)
 
 decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> IO (Either String (OnionMessage Identity, OnionDestination r))
 decrypt crypto msg addr = do
     (skey,pkey) <- selectKey crypto msg addr
+    let decipher1 :: Serialize a =>
+                     TransportCrypto -> SecretKey -> PublicKey -> Nonce24
+                     -> Either (PublicKey,Encrypted a) (Asymm (Encrypted a))
+                     -> (IO ∘ Either String ∘ Identity) a
+        decipher1 crypto k pk n d = Composed $ do
+            secret <- lookupSharedSecret crypto k pk n
+            let ciphered = either snd asymmData d
+            return $ Composed $ do
+                plain <- ToxCrypto.decrypt secret ciphered
+                Identity <$> decodePlain plain
+        decipher :: Serialize a
+            => Nonce24 -> Either (Encrypted a) (Asymm (Encrypted a))
+                       -> (IO ∘ Either String ∘ Identity) a
+        decipher = (\n -> decipher1 crypto skey pkey n . left (senderkey addr))
+    foo <- sequenceMessage $ transcode decipher msg
     return $ do
-        msg <- sequenceMessage $ transcode (\n -> decryptMessage (skey,pkey) n . left (senderkey addr)) msg
+        msg <- sequenceMessage foo
         Right (msg, addr)
 
 senderkey :: OnionDestination r -> t -> (PublicKey, t)
@@ -696,16 +714,17 @@ dhtKey :: TransportCrypto -> (SecretKey,PublicKey)
 dhtKey crypto = (transportSecret &&& transportPublic) crypto
 
 decryptMessage :: Serialize x =>
-                  (SecretKey,PublicKey)
+                  TransportCrypto
+                  -> (SecretKey,PublicKey)
                   -> Nonce24
                   -> Either (PublicKey, Encrypted x)
                             (Asymm (Encrypted x))
-                  -> (Either String ∘ Identity) x
-decryptMessage crypto n arg = plain $ ToxCrypto.decrypt secret e
- where
-    secret     = computeSharedSecret (fst crypto) sender n
-    (sender,e) = either id (senderKey &&& asymmData) arg
-    plain      = Composed . fmap Identity . (>>= decodePlain)
+                  -> IO ((Either String ∘ Identity) x)
+decryptMessage crypto (sk,pk) n arg = do
+    let (sender,e) = either id (senderKey &&& asymmData) arg
+        plain      = Composed . fmap Identity . (>>= decodePlain)
+    secret <- lookupSharedSecret crypto sk sender n
+    return $ plain $ ToxCrypto.decrypt secret e
 
 
 sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f)
@@ -732,37 +751,41 @@ data OnionRoute = OnionRoute
     , routeNodeC  :: NodeInfo
     }
 
-wrapForRoute :: OnionMessage Encrypted -> NodeInfo -> OnionRoute -> OnionRequest N0
-wrapForRoute msg ni r =
+wrapForRoute :: TransportCrypto -> OnionMessage Encrypted -> NodeInfo -> OnionRoute -> IO (OnionRequest N0)
+wrapForRoute crypto msg ni r = do
     -- We needn't use the same nonce value here, but I think it is safe to do so.
     let nonce = msgNonce msg
-    in OnionRequest
-    { onionNonce = nonce
-    , onionForward = wrapOnion (routeAliasA r)
-                               nonce
-                               (id2key . nodeId $ routeNodeA r)
-                               (nodeAddr $ routeNodeB r)
-                   $ wrapOnion (routeAliasB r)
-                               nonce
-                               (id2key . nodeId $ routeNodeB r)
-                               (nodeAddr $ routeNodeC r)
-                   $ wrapOnion (routeAliasC r)
-                               nonce
-                               (id2key . nodeId $ routeNodeC r)
-                               (nodeAddr ni)
-                   $ NotForwarded msg
-    , pathFromOwner = NoReturnPath
-    }
+    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 OnionRequest
+        { onionNonce    = nonce
+        , onionForward  = fwd
+        , pathFromOwner = NoReturnPath
+        }
 
 wrapOnion :: Serialize (Forwarding n msg) =>
-           SecretKey
+           TransportCrypto
+           -> 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)
+           -> IO (Forwarding (S n) msg)
+wrapOnion crypto skey nonce destkey saddr fwd = do
+    let plain = encodePlain $ Addressed saddr fwd
+    secret <- lookupSharedSecret crypto skey destkey nonce
+    return $ Forwarding (toPublic skey) $ ToxCrypto.encrypt secret plain
 
 
 -- TODO
@@ -827,28 +850,29 @@ parseDataToRoute
 parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
   ks <- atomically $ readTVar $ userKeys crypto
 
-  let eOuter = do
-        fmap runIdentity
-                 $ uncomposed
-                 $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto)
-                                  (asymmNonce dta)
-                                  (Right dta) -- using Asymm{senderKey} as remote key
-
-      -- TODO: We don't currently have a way to look up which user key we
-      -- announced using along this onion route.  Therefore, for now, we will
-      -- try all our user keys to see if any can decrypt the packet.
-      eInners = flip map ks $ \(sk,pk) -> do
-        dtr <- eOuter
-        omsg <- fmap runIdentity
-                $ uncomposed
-                $ decryptMessage (sk,pk)
+  omsg0 <- decryptMessage crypto (rendezvousSecret crypto,rendezvousPublic crypto)
+                                (asymmNonce dta)
+                                (Right dta) -- using Asymm{senderKey} as remote key
+  let eOuter = fmap runIdentity $ uncomposed omsg0
+
+      anyRight [] f     = return $ Left "parseDataToRoute: no user key"
+      anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right)
+
+  -- TODO: We don't currently have a way to look up which user key we
+  -- announced using along this onion route.  Therefore, for now, we will
+  -- try all our user keys to see if any can decrypt the packet.
+  eInner <- case eOuter of
+    Left e    -> return $ Left e
+    Right dtr -> anyRight ks $ \(sk,pk) -> do
+        omsg0 <- decryptMessage crypto
+                                 (sk,pk)
                                  (asymmNonce dta)
                                  (Left (dataFromKey dtr, dataToRoute dtr))
-        return (pk,dtr,omsg)
-
-      eInner = foldr (<|>) (Left "no user key") eInners
+        return $ do
+            omsg <- fmap runIdentity . uncomposed $ omsg0
+            Right (pk,dtr,omsg)
 
-      e = do
+  let e = do
         (pk,dtr,omsg) <- eInner
         return ( (pk, omsg)
                , AnnouncedRendezvous
@@ -875,10 +899,12 @@ encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub n
     let (sk,pk) = case asel of
             AnnouncingAlias sk pk -> (sk,pk)
             _                     -> (onionAliasSecret crypto, onionAliasPublic crypto)
-    let plain = DataToRoute { dataFromKey = pk
-                            , dataToRoute = encryptMessage sk toxid nonce omsg
-                            }
-    let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain
+    innerSecret <- lookupSharedSecret crypto sk toxid nonce
+    let plain = encodePlain $ DataToRoute { dataFromKey = pk
+                                          , dataToRoute = ToxCrypto.encrypt innerSecret $ encodePlain omsg
+                                          }
+    outerSecret <- lookupSharedSecret crypto (onionAliasSecret crypto) pub nonce
+    let dta = ToxCrypto.encrypt outerSecret plain
     hPutStrLn stderr $ unlines
         [ "encodeDataToRoute    me=" ++ show (key2id me)
         , "                  dhtpk=" ++ case omsg of
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index 01928e56..30df93c8 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -29,7 +29,7 @@ toxTransport ::
 toxTransport crypto orouter closeLookup udp = do
     (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp
     (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
-                                        (encodeOnionAddr $ lookupRoute orouter)
+                                        (encodeOnionAddr crypto $ lookupRoute orouter)
                                         udp1
     (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1
     let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2