WIP: Support for sending onion queries to TCP relays.

1 files changed, 40 insertions, 1029 deletions

diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 8918f913..e746c414 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -1,21 +1,3 @@
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE PartialTypeSignatures      #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE TupleSections              #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE UndecidableInstances       #-}
 module Network.Tox.Onion.Transport
     ( parseOnionAddr
     , encodeOnionAddr
@@ -58,856 +40,51 @@ module Network.Tox.Onion.Transport
     , wrapOnionPure
     ) where
 
-import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
-import Network.QueryResponse
-import Crypto.Tox hiding (encrypt,decrypt)
-import Network.Tox.NodeId
-import qualified Crypto.Tox as ToxCrypto
-import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey(..),FriendRequest,asymNodeInfo)
-
-import Control.Applicative
-import Control.Arrow
-import Control.Concurrent.STM
-import Control.Monad
-import qualified Data.ByteString    as B
-         ;import Data.ByteString    (ByteString)
-import Data.Data
-import Data.Function
-import Data.Functor.Contravariant
-import Data.Functor.Identity
-#if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
-#else
-import Data.IP
-#endif
-import Data.Maybe
-import Data.Monoid
-import Data.Serialize               as S
-import Data.Type.Equality
-import Data.Typeable
-import Data.Word
-import GHC.Generics                 ()
-import GHC.TypeLits
+import Data.ByteString (ByteString)
+import Data.Serialize
 import Network.Socket
-import qualified Text.ParserCombinators.ReadP as RP
-import Data.Hashable
-import DPut
-import DebugTag
-import Data.Word64Map (fitsInInt)
-import Data.Bits (shiftR,shiftL)
-import qualified Rank2
-
-type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
-
-type UDPTransport = Transport String SockAddr ByteString
-
-
-getOnionAsymm :: Get (Asymm (Encrypted DataToRoute))
-getOnionAsymm = getAliasedAsymm
-
-putOnionAsymm :: Serialize a => Word8 -> Put -> Asymm a -> Put
-putOnionAsymm typ p a = put typ >> p >> putAliasedAsymm a
-
-data OnionMessage (f :: * -> *)
-    = OnionAnnounce (Asymm (f (AnnounceRequest,Nonce8)))
-    | OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse) -- XXX: Why is Nonce8 transmitted in the clear?
-    | OnionToRoute PublicKey (Asymm (Encrypted DataToRoute)) -- destination key, aliased Asymm
-    | OnionToRouteResponse (Asymm (Encrypted DataToRoute))
-
-deriving instance ( Eq (f (AnnounceRequest, Nonce8))
-                  , Eq (f AnnounceResponse)
-                  , Eq (f DataToRoute)
-                  ) => Eq (OnionMessage f)
-
-deriving instance ( Ord (f (AnnounceRequest, Nonce8))
-                  , Ord (f AnnounceResponse)
-                  , Ord (f DataToRoute)
-                  ) => Ord (OnionMessage f)
-
-deriving instance ( Show (f (AnnounceRequest, Nonce8))
-                  , Show (f AnnounceResponse)
-                  , Show (f DataToRoute)
-                  ) => Show (OnionMessage f)
-
-instance Data (OnionMessage Encrypted) where
-  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
-  toConstr _     = error "OnionMessage.toConstr"
-  gunfold _ _    = error "OnionMessage.gunfold"
-#if MIN_VERSION_base(4,2,0)
-  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionMessage"
-#else
-  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionMessage"
-#endif
-
-instance Rank2.Functor OnionMessage where
-    f <$> m = mapPayload (Proxy :: Proxy Serialize) f m
-
-instance Payload Serialize OnionMessage where
-    mapPayload _ f (OnionAnnounce a)                = OnionAnnounce (fmap f a)
-    mapPayload _ f (OnionAnnounceResponse n8 n24 a) = OnionAnnounceResponse n8 n24 (f a)
-    mapPayload _ f (OnionToRoute k a)               = OnionToRoute k a
-    mapPayload _ f (OnionToRouteResponse a)         = OnionToRouteResponse a
-
-
-msgNonce :: OnionMessage f -> Nonce24
-msgNonce (OnionAnnounce a)               = asymmNonce a
-msgNonce (OnionAnnounceResponse _ n24 _) = n24
-msgNonce (OnionToRoute _ a)              = asymmNonce a
-msgNonce (OnionToRouteResponse a)        = asymmNonce a
-
-data AliasSelector = SearchingAlias | AnnouncingAlias SecretKey PublicKey
-    deriving (Eq,Show)
-
-data OnionDestination r
-    = OnionToOwner
-        { onionNodeInfo   :: NodeInfo
-        , onionReturnPath :: ReturnPath N3 -- ^ Somebody else's path to us.
-        }
-    | OnionDestination
-        { onionAliasSelector' :: AliasSelector
-        , onionNodeInfo       :: NodeInfo
-        , onionRouteSpec      :: Maybe r    -- ^ Our own onion-path.
-        }
-    deriving Show
-
-onionAliasSelector :: OnionDestination r -> AliasSelector
-onionAliasSelector (OnionToOwner    {}                         ) = SearchingAlias
-onionAliasSelector (OnionDestination{onionAliasSelector' = sel}) = sel
-
-onionKey :: OnionDestination r -> PublicKey
-onionKey od = id2key . nodeId $ onionNodeInfo od
-
-instance Sized (OnionMessage Encrypted) where
-    size = VarSize $ \case
-        OnionAnnounce a -> case size of ConstSize n -> n + 1
-                                        VarSize f   -> f a + 1
-        OnionAnnounceResponse n8 n24 x -> case size of ConstSize n -> n + 33
-                                                       VarSize f   -> f x + 33
-        OnionToRoute pubkey a -> case size of ConstSize n -> n + 33
-                                              VarSize f   -> f a + 33
-        OnionToRouteResponse a -> case size of ConstSize n -> n + 1
-                                               VarSize f   -> f a + 1
-
-instance Serialize (OnionMessage Encrypted) where
-    get = do
-        typ <- get
-        case typ :: Word8 of
-            0x83 -> OnionAnnounce <$> getAliasedAsymm
-            0x85 -> OnionToRoute <$> getPublicKey <*> getAliasedAsymm
-            t    -> fail ("Unknown onion payload: " ++ show t)
-                    `fromMaybe` getOnionReply t
-    put (OnionAnnounce a)                = putWord8 0x83 >> putAliasedAsymm a
-    put (OnionToRoute k a)               = putWord8 0x85 >> putPublicKey k >> putAliasedAsymm a
-    put (OnionAnnounceResponse n8 n24 x) = putWord8 0x84 >> put n8 >> put n24 >> put x
-    put (OnionToRouteResponse a)         = putWord8 0x86 >> putAliasedAsymm a
-
-onionToOwner :: Asymm a -> ReturnPath N3 -> SockAddr -> Either String (OnionDestination r)
-onionToOwner asymm ret3 saddr = do
-    ni <- nodeInfo (key2id $ senderKey asymm) saddr
-    return $ OnionToOwner ni ret3
--- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr
-
-
-onion :: Sized msg =>
-               ByteString
-               -> SockAddr
-               -> Get (Asymm (Encrypted msg) -> t)
-               -> Either String (t, OnionDestination r)
-onion bs saddr getf = do (f,(asymm,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
-                         oaddr <- onionToOwner asymm ret3 saddr
-                         return (f asymm, oaddr)
-
-parseOnionAddr :: (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination 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 = 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
-    _ -> 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 . \od -> (msg,od))
-                      maddr
-            Just (Right msg@(OnionToRouteResponse asym)) -> do
-                let ni = asymNodeInfo saddr asym
-                return $ Left (msg, OnionDestination SearchingAlias ni Nothing)
-            _ -> return right
-
-getOnionReply :: Word8 -> Maybe (Get (OnionMessage Encrypted))
-getOnionReply 0x84 = Just $ OnionAnnounceResponse <$> get <*> get <*> get
-getOnionReply 0x86 = Just $ OnionToRouteResponse <$> getOnionAsymm
-getOnionReply _    = Nothing
-
-putOnionMsg :: OnionMessage Encrypted -> Put
-putOnionMsg (OnionAnnounce                a) = putOnionAsymm 0x83 (return ()) a
-putOnionMsg (OnionToRoute pubkey          a) = putOnionAsymm 0x85 (putPublicKey pubkey) a
-putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
-putOnionMsg (OnionToRouteResponse         a) = putOnionAsymm 0x86 (return ()) a
-
-newtype RouteId = RouteId Int
- deriving Show
-
-
--- We used to derive the RouteId from the Nonce8 associated with the query.
--- This is problematic because a nonce generated by toxcore will not validate
--- if it is received via a different route than it was issued.  This is
--- described by the Tox spec:
---
---   Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current
---   time, some secret bytes generated when the instance is created, the
---   current time divided by a 20 second timeout, the public key of the
---   requester and the source ip/port that the packet was received from. Since
---   the ip/port that the packet was received from is in the `ping_id`, the
---   announce packets being sent with a ping id must be sent using the same
---   path as the packet that we received the `ping_id` from or announcing will
---   fail.
---
--- The original idea was:
---
--- > routeId :: Nonce8 -> RouteId
--- > routeId (Nonce8 w8) = RouteId $ mod (fromIntegral w8) 12
---
--- Instead, we'll just hash the destination node id.
-routeId :: NodeId -> RouteId
-routeId nid = RouteId $ mod (hash nid) 12
 
+import Crypto.Tox hiding (encrypt,decrypt)
+import qualified Data.Tox.Relay as TCP
+import Data.Tox.Onion
+import Network.Tox.NodeId
 
+{-
 encodeOnionAddr :: TransportCrypto
                    -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
                    -> (OnionMessage Encrypted,OnionDestination RouteId)
                    -> IO (Maybe (ByteString, SockAddr))
+-}
+encodeOnionAddr :: TransportCrypto
+                     -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
+                     -> (OnionMessage Encrypted, OnionDestination RouteId)
+                     -> IO (Maybe
+                             (Either (TCP.RelayPacket, TCP.NodeInfo) (ByteString, SockAddr)))
 encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
-    return $ Just ( runPut $ putResponse (OnionResponse p msg)
-                  , nodeAddr ni )
+    return $ Just $ Right ( runPut $ putResponse (OnionResponse p msg)
+                          , nodeAddr ni )
 encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
     encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
     -- dput XMisc $ "ONION encode missing routeid"
     -- return Nothing
 encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
-            req <- wrapForRoute crypto msg ni route
-            return ( runPut $ putRequest req
-                   , nodeAddr $ routeNodeA route)
+            mreq <- wrapForRoute crypto msg ni route
+            case mreq of
+                Right req -> return $ Right ( runPut $ putRequest req , nodeAddr $ routeNodeA route)
+                Left o | Just port <- routeRelayPort route
+                          -> return $ Left ( o, TCP.NodeInfo (routeNodeA route) port)
     m <- {-# SCC "encodeOnionAddr.getRoute" #-} getRoute ni rid
     x <- {-# SCC "encodeOnionAddr.wrapForRoute" #-} mapM go m
     return x
 
-
-forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport
-forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP }
-
-forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
-forwardAwait crypto udp sendTCP kont = do
-    fix $ \another -> do
-      awaitMessage udp $ \case
-        m@(Just (Right (bs,saddr))) -> case B.head bs of
-            0x80 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy  N0) crypto (Addressed saddr) udp another
-            0x81 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy  N1) crypto (Addressed saddr) udp another
-            0x82 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy  N2) crypto (Addressed saddr) udp another
-            0x8c -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N3) crypto saddr udp sendTCP another
-            0x8d -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N2) crypto saddr udp sendTCP another
-            0x8e -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N1) crypto saddr udp sendTCP another
-            _    -> kont m
-        m -> kont m
-
-forward :: forall c b b1. (Serialize b, Show b) =>
-              (Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c
-forward kont bs f = either (kont . Just . Left) f $ decode $ B.tail bs
-
-class SumToThree a b
-
-instance SumToThree N0 N3
-instance SumToThree (S a) b => SumToThree a (S b)
-
-class ( Serialize (ReturnPath n)
-      , Serialize (ReturnPath (S n))
-      , Serialize (Forwarding (ThreeMinus (S n)) (OnionMessage Encrypted))
-      , ThreeMinus n ~ S (ThreeMinus (S n))
-      ) => LessThanThree n
-
-instance LessThanThree N0
-instance LessThanThree N1
-instance LessThanThree N2
-
-type family ThreeMinus n where
-    ThreeMinus N3 = N0
-    ThreeMinus N2 = N1
-    ThreeMinus N1 = N2
-    ThreeMinus N0 = N3
-
--- n = 0, 1, 2
-data OnionRequest n = OnionRequest
-    { onionNonce    :: Nonce24
-    , onionForward  :: Forwarding (ThreeMinus n) (OnionMessage Encrypted)
-    , pathFromOwner :: ReturnPath n
-    }
- deriving (Eq,Ord)
-
-
-{-
-instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n)
-         , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
-         ) => Data (OnionRequest n) where
-  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
-  toConstr _     = error "OnionRequest.toConstr"
-  gunfold _ _    = error "OnionRequest.gunfold"
-#if MIN_VERSION_base(4,2,0)
-  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionRequest"
-#else
-  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionRequest"
-#endif
--}
-
-
-instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where
-  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
-  toConstr _     = error "OnionResponse.toConstr"
-  gunfold _ _    = error "OnionResponse.gunfold"
-#if MIN_VERSION_base(4,2,0)
-  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionResponse"
-#else
-  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionResponse"
-#endif
-
-deriving instance ( Show (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
-                  , KnownNat (PeanoNat n)
-                  ) => Show (OnionRequest n)
-
-instance Sized (OnionRequest N0) where -- N1 and N2 are the same, N3 does not encode the nonce.
-    size = contramap onionNonce size
-        <> contramap onionForward size
-        <> contramap pathFromOwner size
-
-instance ( Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
-         , Sized (ReturnPath n)
-         , Serialize (ReturnPath n)
-         , Typeable n
-         ) => Serialize (OnionRequest n) where
-    get = do
-        -- TODO share code with 'getOnionRequest'
-        n24 <- case eqT :: Maybe (n :~: N3) of
-                Just Refl -> return $ Nonce24 zeros24
-                Nothing   -> get
-        cnt <- remaining
-        let fwdsize = case size :: Size (ReturnPath n) of ConstSize n -> cnt - n
-        fwd <- isolate fwdsize get
-        rpath <- get
-        return $ OnionRequest n24 fwd rpath
-    put (OnionRequest n f p) = maybe (put n) (\Refl -> return ()) (eqT :: Maybe (n :~: N3)) >> put f >> put p
-
--- getRequest :: _
--- getRequest = OnionRequest <$> get <*> get <*> get
-
--- n = 1, 2, 3
--- Attributed (Encrypted (
-
-data OnionResponse n = OnionResponse
-    { pathToOwner :: ReturnPath n
-    , msgToOwner  :: OnionMessage Encrypted
-    }
-    deriving (Eq,Ord)
-
-deriving instance KnownNat (PeanoNat n) => Show (OnionResponse n)
-
-instance ( Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where
-    get = OnionResponse <$> get <*> (get >>= fromMaybe (fail "illegal onion forwarding")
-                                             . getOnionReply)
-    put (OnionResponse p m) = put p >> putOnionMsg m
-
-instance (Sized (ReturnPath n)) => Sized (OnionResponse (S n)) where
-    size = contramap pathToOwner size <> contramap msgToOwner size
-
-data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
-                 | TCPIndex { tcpIndex :: Int, unaddressed :: a }
- deriving (Eq,Ord,Show)
-
-instance (Typeable a, Serialize a) => Data (Addressed a) where
-  gfoldl f z a   = z (either error id . S.decode) `f` S.encode a
-  toConstr _     = error "Addressed.toConstr"
-  gunfold _ _    = error "Addressed.gunfold"
-#if MIN_VERSION_base(4,2,0)
-  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.Addressed"
-#else
-  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.Addressed"
-#endif
-
-instance Sized a => Sized (Addressed a) where
-    size = case size :: Size a of
-            ConstSize n -> ConstSize     $ 1{-family-} + 16{-ip-} + 2{-port-} + n
-            VarSize f   -> VarSize $ \x -> 1{-family-} + 16{-ip-} + 2{-port-} + f (unaddressed x)
-
-getForwardAddr :: S.Get SockAddr
-getForwardAddr = do
-    addrfam <- S.get :: S.Get Word8
-    ip <- getIP addrfam
-    case ip of IPv4 _ -> S.skip 12 -- compliant peers would zero-fill this.
-               IPv6 _ -> return ()
-    port <- S.get :: S.Get PortNumber
-    return $ setPort port $ toSockAddr ip
-
-
-putForwardAddr :: SockAddr -> S.Put
-putForwardAddr saddr = fromMaybe (return $ error "unsupported SockAddr family") $ do
-    port <- sockAddrPort saddr
-    ip <- fromSockAddr $ either id id $ either4or6 saddr
-    return $ do
-        case ip of
-            IPv4 ip4 -> S.put (0x02 :: Word8) >> S.put ip4 >> S.putByteString (B.replicate 12 0)
-            IPv6 ip6 -> S.put (0x0a :: Word8) >> S.put ip6
-        S.put port
-
-addrToIndex :: SockAddr -> Int
-addrToIndex (SockAddrInet6 _ _ (lo, hi, _, _) _) =
-    if fitsInInt (Proxy :: Proxy Word64)
-        then fromIntegral lo + (fromIntegral hi `shiftL` 32)
-        else fromIntegral lo
-addrToIndex _ = 0
-
-indexToAddr :: Int -> SockAddr
-indexToAddr x = SockAddrInet6 0 0 (fromIntegral x, fromIntegral (x `shiftR` 32),0,0) 0
-
--- Note, toxcore would check an address family byte here to detect a TCP-bound
--- packet, but we instead use the IPv6 id and rely on the port number being
--- zero.  Since it will be symmetrically encrypted for our eyes only, it's not
--- important to conform on this point.
-instance Serialize a => Serialize (Addressed a) where
-    get = do saddr <- getForwardAddr
-             a <- get
-             case sockAddrPort saddr of
-                Just 0 -> return $ TCPIndex (addrToIndex saddr) a
-                _      -> return $ Addressed saddr a
-    put (Addressed addr x) = putForwardAddr addr >> put x
-    put (TCPIndex  idx  x) = putForwardAddr (indexToAddr idx) >> put x
-
-data N0
-data S n
-type N1 = S N0
-type N2 = S N1
-type N3 = S N2
-
-deriving instance Data N0
-deriving instance Data n => Data (S n)
-
-class KnownPeanoNat n where
-    peanoVal :: p n -> Int
-
-instance KnownPeanoNat N0 where
-    peanoVal _ = 0
-instance KnownPeanoNat n => KnownPeanoNat (S n) where
-    peanoVal _ = 1 + peanoVal (Proxy :: Proxy n)
-
-type family PeanoNat p where
-    PeanoNat N0    = 0
-    PeanoNat (S n) = 1 + PeanoNat n
-
-data ReturnPath n where
-    NoReturnPath :: ReturnPath N0
-    ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (S n)
-
-deriving instance Eq (ReturnPath n)
-deriving instance Ord (ReturnPath n)
-
--- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
-instance Sized (ReturnPath N0) where size = ConstSize 0
-instance Sized (ReturnPath n) => Sized (ReturnPath (S n)) where
-    size = ConstSize 59 <> contramap (\x -> let _ = x :: ReturnPath (S n)
-                                            in error "non-constant ReturnPath size")
-                                     (size :: Size (ReturnPath n))
-
-{-
-instance KnownNat (PeanoNat n) => Sized (ReturnPath n) where
-    size = ConstSize $ 59 * fromIntegral (natVal (Proxy :: Proxy (PeanoNat n)))
--}
-
-instance Serialize (ReturnPath N0) where get              = pure NoReturnPath
-                                         put NoReturnPath = pure ()
-
-instance Serialize (ReturnPath N1) where
-    get = ReturnPath <$> get <*> get
-    put (ReturnPath n24 p) = put n24 >> put p
-
-instance (Sized (ReturnPath n), Serialize (ReturnPath n)) => Serialize (ReturnPath (S (S n))) where
-    get = ReturnPath <$> get <*> get
-    put (ReturnPath n24 p) = put n24 >> put p
-
-
-{-
--- This doesn't work because it tried to infer it for (0 - 1)
-instance (Serialize (Encrypted (Addressed (ReturnPath (n - 1))))) => Serialize (ReturnPath n) where
-    get = ReturnPath <$> get <*> get
-    put (ReturnPath n24 p) = put n24 >> put p
--}
-
-instance KnownNat (PeanoNat n) => Show (ReturnPath n) where
-    show rpath = "ReturnPath" ++ show (natVal (Proxy :: Proxy (PeanoNat n)))
-
-
--- instance KnownNat n => Serialize (ReturnPath n) where
---     -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
---     get = ReturnPath <$> getBytes ( 59 * (fromIntegral $ natVal $ Proxy @n) )
---     put (ReturnPath bs) = putByteString bs
-
-
-data Forwarding n msg where
-    NotForwarded :: msg -> Forwarding N0 msg
-    Forwarding :: PublicKey -> Encrypted (Addressed (Forwarding n msg)) -> Forwarding (S n) msg
-
-deriving instance Eq msg => Eq (Forwarding n msg)
-deriving instance Ord msg => Ord (Forwarding n msg)
-
-instance Show msg => Show (Forwarding N0 msg) where
-    show (NotForwarded x) = "NotForwarded "++show x
-
-instance ( KnownNat (PeanoNat (S n))
-         , Show (Encrypted (Addressed (Forwarding n msg)))
-         ) => Show (Forwarding (S n) msg) where
-    show (Forwarding k a) = unwords [ "Forwarding"
-                                    , "("++show (natVal (Proxy :: Proxy (PeanoNat (S n))))++")"
-                                    , show (key2id k)
-                                    , show a
-                                    ]
-
-instance Sized msg => Sized (Forwarding N0 msg)
-   where size = case size :: Size msg of
-                 ConstSize n -> ConstSize n
-                 VarSize f -> VarSize $ \(NotForwarded x) -> f x
-
-instance Sized (Forwarding n msg) => Sized (Forwarding (S n) msg)
-   where size = ConstSize 32
-                <> contramap (\(Forwarding _ e) -> e)
-                             (size :: Size (Encrypted (Addressed (Forwarding n msg))))
-
-instance Serialize msg => Serialize (Forwarding N0 msg) where
-    get = NotForwarded <$> get
-    put (NotForwarded msg) = put msg
-
-instance (Serialize (Encrypted (Addressed (Forwarding n msg)))) => Serialize (Forwarding (S n) msg) where
-    get = Forwarding <$> getPublicKey <*> get
-    put (Forwarding k x) = putPublicKey k >> put x
-
-{-
-rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)),
-                 Serialize (ReturnPath n),
-                 Serialize
-                   (Forwarding (ThreeMinus (S n)) (OnionMessage Encrypted))) =>
-                TransportCrypto
-                -> (forall x. x -> Addressed x)
-                -> OnionRequest n
-                -> IO (Either String (OnionRequest (S n), SockAddr))
-rewrap crypto saddr (OnionRequest nonce msg rpath) = do
-    (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto
-                                      <*> transportNewNonce crypto )
-    peeled <- peelOnion crypto nonce msg
-    return $ peeled >>= \case
-        Addressed dst msg'
-          -> Right (OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath, dst)
-        _ -> Left "Onion forward to TCP client?"
--}
-
-handleOnionRequest :: forall a proxy n.
-                      ( LessThanThree n
-                      , KnownPeanoNat n
-                      , Sized (ReturnPath n)
-                      , Typeable n
-                      ) => proxy n -> TransportCrypto -> (forall x. x -> Addressed x) -> UDPTransport -> IO a -> OnionRequest n -> IO a
-handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do
-    let n = peanoVal rpath
-    dput XOnion $ "handleOnionRequest " ++ show n
-    (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto
-                                      <*> transportNewNonce crypto )
-    peeled <- peelOnion crypto nonce msg
-    let showDestination = case saddr () of
-            Addressed a _ -> either show show $ either4or6 a
-            TCPIndex  i _ -> "TCP" ++ show [i]
-
-    case peeled of
-        Left e -> do
-            dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e]
-            kont
-        Right (Addressed dst msg') -> do
-            dput XOnion $ unwords [ "peelOnion:", show n, showDestination, "-->", either show show (either4or6 dst), "SUCCESS"]
-            sendMessage udp dst (runPut $ putRequest $ OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath)
-            kont
-        Right (TCPIndex {}) -> do
-            dput XUnexpected "handleOnionRequest: Onion forward to TCP client?"
-            kont
-
-wrapSymmetric :: Serialize (ReturnPath n) =>
-                 SymmetricKey -> Nonce24 -> (forall x. x -> Addressed x) -> ReturnPath n -> ReturnPath (S n)
-wrapSymmetric sym n saddr rpath = ReturnPath n $ encryptSymmetric sym n (encodePlain $ saddr rpath)
-
-peelSymmetric :: Serialize (Addressed (ReturnPath n))
-                 => SymmetricKey -> ReturnPath (S n) -> Either String (Addressed (ReturnPath n))
-peelSymmetric sym (ReturnPath nonce e) = decryptSymmetric sym nonce e >>= decodePlain
-
-
-peelOnion :: Serialize (Addressed (Forwarding n t))
-              => TransportCrypto
-              -> Nonce24
-              -> Forwarding (S n) t
-              -> 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), Typeable n) =>
-                        proxy (S n)
-                        -> TransportCrypto
-                        -> SockAddr
-                        -> UDPTransport
-                        -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-relay onion send.
-                        -> IO a
-                        -> OnionResponse (S n)
-                        -> IO a
-handleOnionResponse proxy crypto saddr udp sendTCP kont (OnionResponse path msg) = do
-    sym <- atomically $ transportSymmetric crypto
-    case peelSymmetric sym path of
-        Left e -> do
-            -- todo report encryption error
-            let n = peanoVal path
-            dput XMisc $ unwords [ "peelSymmetric:", show n, either show show (either4or6 saddr), e]
-            kont
-        Right (Addressed dst path') -> do
-            sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg)
-            kont
-        Right (TCPIndex dst path') -> do
-            case peanoVal path' of
-                0 -> sendTCP dst msg
-                n -> dput XUnexpected $ "handleOnionResponse: TCP-bound OnionResponse" ++ show n ++ " not supported."
-            kont
-
-
-data AnnounceRequest = AnnounceRequest
-    { announcePingId  :: Nonce32 -- Ping ID
-    , announceSeeking :: NodeId  -- Public key we are searching for
-    , announceKey     :: NodeId  -- Public key that we want those sending back data packets to use
-    }
- deriving Show
-
-instance Sized AnnounceRequest where size = ConstSize (32*3)
-
-instance S.Serialize AnnounceRequest where
-    get = AnnounceRequest <$> S.get <*> S.get <*> S.get
-    put (AnnounceRequest p s k) = S.put (p,s,k)
-
-getOnionRequest :: Sized msg => Get (Asymm (Encrypted msg), ReturnPath N3)
-getOnionRequest = do
-    -- Assumes return path is constant size so that we can isolate
-    -- the variable-sized prefix.
-    cnt <- remaining
-    a <- isolate (case size :: Size (ReturnPath N3) of ConstSize n -> cnt - n)
-                 getAliasedAsymm
-    path <- get
-    return (a,path)
-
-putRequest :: ( KnownPeanoNat n
-              , Serialize (OnionRequest n)
-              , Typeable n
-              ) => OnionRequest n -> Put
-putRequest req = do
-    let tag = 0x80 + fromIntegral (peanoVal req)
-    when (tag <= 0x82) (putWord8 tag)
-    put req
-
-putResponse :: (KnownPeanoNat n, Serialize (OnionResponse n)) => OnionResponse n -> Put
-putResponse resp = do
-    let tag = 0x8f - fromIntegral (peanoVal resp)
-    -- OnionResponse N0 is an alias for the OnionMessage Encrypted type which includes a tag
-    -- in it's Serialize instance.
-    when (tag /= 0x8f) (putWord8 tag)
-    put resp
-
-
-data KeyRecord = NotStored    Nonce32
-               | SendBackKey  PublicKey
-               | Acknowledged Nonce32
- deriving Show
-
-instance Sized KeyRecord where size = ConstSize 33
-
-instance S.Serialize KeyRecord where
-    get = do
-        is_stored <- S.get :: S.Get Word8
-        case is_stored of
-            1 -> SendBackKey  <$> getPublicKey
-            2 -> Acknowledged <$> S.get
-            _ -> NotStored    <$> S.get
-    put (NotStored n32)    = S.put (0 :: Word8) >> S.put n32
-    put (SendBackKey key)  = S.put (1 :: Word8) >> putPublicKey key
-    put (Acknowledged n32) = S.put (2 :: Word8) >> S.put n32
-
-data AnnounceResponse = AnnounceResponse
-    { is_stored     :: KeyRecord
-    , announceNodes :: SendNodes
-    }
- deriving Show
-
-instance Sized AnnounceResponse where
-    size = contramap is_stored size <> contramap announceNodes size
-
-getNodeList :: S.Get [NodeInfo]
-getNodeList = do
-    n <- S.get
-    (:) n <$> (getNodeList <|> pure [])
-
-instance S.Serialize AnnounceResponse where
-    get = AnnounceResponse <$> S.get <*> (SendNodes <$> getNodeList)
-    put (AnnounceResponse st (SendNodes ns)) = S.put st >> mapM_ S.put ns
-
-data DataToRoute = DataToRoute
-    { dataFromKey :: PublicKey -- Real public key of sender
-    , dataToRoute :: Encrypted OnionData -- (Word8,ByteString) -- DHTPK 0x9c
-    }
-
-instance Sized DataToRoute where
-    size = ConstSize 32 <> contramap dataToRoute size
-
-instance Serialize DataToRoute where
-    get = DataToRoute <$> getPublicKey <*> get
-    put (DataToRoute k dta) = putPublicKey k >> put dta
-
-data OnionData
-  = -- | type 0x9c
-    --
-    -- We send this packet every 30 seconds if there is more than one peer (in
-    -- the 8) that says they our friend is announced on them. This packet can
-    -- also be sent through the DHT module as a DHT request packet (see DHT) if
-    -- we know the DHT public key of the friend and are looking for them in the
-    -- DHT but have not connected to them yet. 30 second is a reasonable
-    -- timeout to not flood the network with too many packets while making sure
-    -- the other will eventually receive the packet. Since packets are sent
-    -- through every peer that knows the friend, resending it right away
-    -- without waiting has a high likelihood of failure as the chances of
-    -- packet loss happening to all (up to to 8) packets sent is low.
-    --
-    -- If a friend is online and connected to us, the onion will stop all of
-    -- its actions for that friend. If the peer goes offline it will restart
-    -- searching for the friend as if toxcore was just started.
-    OnionDHTPublicKey DHTPublicKey
-  | -- | type 0x20
-    --
-    --
-    OnionFriendRequest FriendRequest -- 0x20
- deriving (Eq,Show)
-
-instance Sized OnionData where
-    size = VarSize $ \case
-        OnionDHTPublicKey dhtpk -> case size of
-            ConstSize n -> n -- Override because OnionData probably
-                             -- should be treated as variable sized.
-            VarSize f   -> f dhtpk
-        -- FIXME: inconsitantly, we have to add in the tag byte for this case.
-        OnionFriendRequest req -> 1 + case size of
-            ConstSize n -> n
-            VarSize f   -> f req
-
-instance Serialize OnionData where
-    get = do
-        tag <- get
-        case tag :: Word8 of
-            0x9c -> OnionDHTPublicKey <$> get
-            0x20 -> OnionFriendRequest <$> get
-            _    -> fail $ "Unknown onion data: "++show tag
-    put (OnionDHTPublicKey dpk) = put (0x9c :: Word8) >> put dpk
-    put (OnionFriendRequest fr) = put (0x20 :: Word8) >> put fr
-
-selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey)
-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 crypto msg rpath = do
-    (skey,pkey) <- selectKey crypto msg rpath -- source key
-    let okey = onionKey rpath                 -- destination key
-        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 -> Nonce24
-                     -> Either (PublicKey,Encrypted a) (Asymm (Encrypted a))
-                     -> (IO ∘ Either String ∘ Identity) a
-        decipher1 crypto k n arg = Composed $ do
-            let (sender,e) = either id (senderKey &&& asymmData) arg
-            secret <- lookupSharedSecret crypto k sender n
-            return $ Composed $ do
-                plain <- ToxCrypto.decrypt secret e
-                Identity <$> decodePlain plain
-        decipher :: Serialize a
-            => Nonce24 -> Either (Encrypted a) (Asymm (Encrypted a))
-                       -> (IO ∘ Either String ∘ Identity) a
-        decipher = (\n -> decipher1 crypto skey n . left (senderkey addr))
-    foo <- sequenceMessage $ transcode decipher msg
-    return $ do
-        msg <- sequenceMessage foo
-        Right (msg, addr)
-
-senderkey :: OnionDestination r -> t -> (PublicKey, t)
-senderkey addr e = (onionKey addr, e)
-
-aliasKey :: TransportCrypto -> OnionDestination r -> (SecretKey,PublicKey)
-aliasKey crypto (OnionToOwner {})     = (transportSecret &&& transportPublic) crypto
-aliasKey crypto (OnionDestination {}) = (onionAliasSecret &&& onionAliasPublic) crypto
-
-dhtKey :: TransportCrypto -> (SecretKey,PublicKey)
-dhtKey crypto = (transportSecret &&& transportPublic) crypto
-
-decryptMessage :: Serialize x =>
-                  TransportCrypto
-                  -> (SecretKey,PublicKey)
-                  -> Nonce24
-                  -> Either (PublicKey, Encrypted x)
-                            (Asymm (Encrypted x))
-                  -> 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)
-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
--- sequenceMessage (OnionToRouteResponse a) = fmap OnionToRouteResponse $ sequenceA $ fmap uncomposed a
-
-transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Asymm (f a)) -> g a) -> OnionMessage f -> OnionMessage g
-transcode f (OnionAnnounce a)        = OnionAnnounce $ a { asymmData = f (asymmNonce 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
--- transcode f (OnionToRouteResponse a) = OnionToRouteResponse $ a { asymmData = f (asymmNonce a) (Right a) }
-
-
-data OnionRoute = OnionRoute
-    { routeAliasA :: SecretKey
-    , routeAliasB :: SecretKey
-    , routeAliasC :: SecretKey
-    , routeNodeA  :: NodeInfo
-    , routeNodeB  :: NodeInfo
-    , routeNodeC  :: NodeInfo
-    }
-
-wrapForRoute :: TransportCrypto -> OnionMessage Encrypted -> NodeInfo -> OnionRoute -> IO (OnionRequest N0)
-wrapForRoute crypto msg ni r = do
+-- wrapForRoute :: TransportCrypto -> OnionMessage Encrypted -> NodeInfo -> OnionRoute -> IO (OnionRequest N0)
+wrapForRoute :: TransportCrypto
+                      -> OnionMessage Encrypted
+                      -> 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)
@@ -923,186 +100,20 @@ wrapForRoute crypto msg ni r = do
                              (id2key . nodeId $ routeNodeC r)
                              (nodeAddr ni)
                              (NotForwarded msg)
-    return OnionRequest
+    return $ Right OnionRequest
         { onionNonce    = nonce
         , onionForward  = fwd
         , pathFromOwner = NoReturnPath
         }
-
-wrapOnion :: Serialize (Forwarding n msg) =>
-           TransportCrypto
-           -> SecretKey
-           -> Nonce24
-           -> PublicKey
-           -> SockAddr
-           -> Forwarding n msg
-           -> 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
-
-wrapOnionPure :: Serialize (Forwarding n msg) =>
-           SecretKey
-           -> ToxCrypto.State
-           -> SockAddr
-           -> Forwarding n msg
-           -> Forwarding (S n) msg
-wrapOnionPure skey st saddr fwd = Forwarding (toPublic skey) (ToxCrypto.encrypt st plain)
- where
-    plain = encodePlain $ Addressed saddr fwd
-
-
-
--- TODO
--- Two types of packets may be sent to Rendezvous via OnionToRoute requests.
---
---  (1) DHT public key packet (0x9c)
---
---  (2) Friend request
-data Rendezvous = Rendezvous
-    { rendezvousKey :: PublicKey
-    , rendezvousNode :: NodeInfo
-    }
- deriving Eq
-
-instance Show Rendezvous where
-    showsPrec d (Rendezvous k ni)
-        = showsPrec d (key2id k)
-          . (':' :)
-          . showsPrec d ni
-
-instance Read Rendezvous where
-    readsPrec d = RP.readP_to_S $ do
-        rkstr <- RP.munch (/=':')
-        RP.char ':'
-        nistr <- RP.munch (const True)
-        return Rendezvous
-                { rendezvousKey = id2key $ read rkstr
-                , rendezvousNode = read nistr
-                }
-
-
-data AnnouncedRendezvous = AnnouncedRendezvous
-    { remoteUserKey :: PublicKey
-    , rendezvous :: Rendezvous
-    }
-  deriving Eq
-
-instance Show AnnouncedRendezvous where
-    showsPrec d (AnnouncedRendezvous remote rendez)
-        = showsPrec d (key2id remote)
-          . (':' :)
-          . showsPrec d rendez
-
-instance Read AnnouncedRendezvous where
-    readsPrec d = RP.readP_to_S $ do
-        ukstr <- RP.munch (/=':')
-        RP.char ':'
-        rkstr <- RP.munch (/=':')
-        RP.char ':'
-        nistr <- RP.munch (const True)
-        return AnnouncedRendezvous
-            { remoteUserKey = id2key $ read ukstr
-            , rendezvous = Rendezvous
-                { rendezvousKey = id2key $ read rkstr
-                , rendezvousNode = read nistr
-                }
-            }
-
-
-selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
-selectAlias crypto pkey = do
-        ks <- filter (\(sk,pk) -> pk == id2key pkey)
-                                <$> userKeys crypto
-        maybe (return SearchingAlias)
-              (return . uncurry AnnouncingAlias)
-              (listToMaybe ks)
-
-
-parseDataToRoute
-    :: TransportCrypto
-         -> (OnionMessage Encrypted,OnionDestination r)
-         -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r))
-parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
-  ks <- atomically $ userKeys crypto
-
-  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 $ do
-            omsg <- fmap runIdentity . uncomposed $ omsg0
-            Right (pk,dtr,omsg)
-
-  let e = do
-        (pk,dtr,omsg) <- eInner
-        return ( (pk, omsg)
-               , AnnouncedRendezvous
-                    (dataFromKey dtr)
-                    $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od )
-      r = either (const $ Right (OnionToRouteResponse dta,od)) Left e
-  -- parseDataToRoute OnionToRouteResponse decipherAndAuth: auth fail
-  case e of
-    Left _  -> dput XMisc $ "Failed keys: " ++ show (map (key2id . snd) ks)
-    Right _ -> return ()
-  dput XMisc $ unlines
-        [ "parseDataToRoute " ++ either id (const "Right") e
-        , "       crypto inner.me   = " ++ either id (\(pk,_,_) -> show $ key2id pk) eInner
-        , "              inner.them = " ++ either id (show . key2id . dataFromKey) eOuter
-        , "              outer.me   = " ++ show (key2id $ rendezvousPublic crypto)
-        , "              outer.them = " ++ show (key2id $ senderKey dta)
-        ]
-  return r
-parseDataToRoute _ msg = return $ Right msg
-
-encodeDataToRoute :: TransportCrypto
-                     -> ((PublicKey,OnionData),AnnouncedRendezvous)
-                     -> IO (Maybe (OnionMessage Encrypted,OnionDestination r))
-encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub ni)) = do
-    nonce <- atomically $ transportNewNonce crypto
-    asel <- atomically $ selectAlias crypto (key2id me)
-    let (sk,pk) = case asel of
-            AnnouncingAlias sk pk -> (sk,pk)
-            _                     -> (onionAliasSecret crypto, onionAliasPublic crypto)
-    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
-    dput XOnion $ unlines
-        [ "encodeDataToRoute    me=" ++ show (key2id me)
-        , "                  dhtpk=" ++ case omsg of
-                                        OnionDHTPublicKey dmsg -> show (key2id $ dhtpk dmsg)
-                                        OnionFriendRequest fr  -> "friend request"
-        , "                     ns=" ++ case omsg of
-                                        OnionDHTPublicKey dmsg -> show (dhtpkNodes dmsg)
-                                        OnionFriendRequest fr  -> "friend request"
-        , "       crypto inner.me =" ++ show (key2id pk)
-        , "              inner.you=" ++ show (key2id toxid)
-        , "              outer.me =" ++ show (key2id $ onionAliasPublic crypto)
-        , "              outer.you=" ++ show (key2id pub)
-        , "                  " ++ show (AnnouncedRendezvous toxid (Rendezvous pub ni))
-        , "                  " ++ show dta
-        ]
-    return $ Just ( OnionToRoute toxid -- Public key of destination node
-                                 Asymm { senderKey  = onionAliasPublic crypto
-                                       , asymmNonce = nonce
-                                       , asymmData  = dta
-                                       }
-                  , OnionDestination SearchingAlias ni Nothing )
+wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort = Just tcpport} = do
+    let nonce = msgNonce msg
+    fwd <- 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 $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd