7 files changed, 1234 insertions, 1091 deletions

diff --git a/src/Data/Tox/Onion.hs b/src/Data/Tox/Onion.hs
new file mode 100644
index 00000000..85a9d21e
--- /dev/null
+++ b/src/Data/Tox/Onion.hs
@@ -0,0 +1,1028 @@
+{-# 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 Data.Tox.Onion 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 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
+
+
+
+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
+    , routeRelayPort :: Maybe PortNumber
+    }
+
+
+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 )
diff --git a/src/Data/Tox/Relay.hs b/src/Data/Tox/Relay.hs
index 02300866..d1e9fb99 100644
--- a/src/Data/Tox/Relay.hs
+++ b/src/Data/Tox/Relay.hs
@@ -8,16 +8,24 @@
 {-# LANGUAGE UndecidableInstances       #-}
 module Data.Tox.Relay where
 
+import Data.Aeson (ToJSON(..),FromJSON(..))
+import qualified Data.Aeson as JSON
 import Data.ByteString as B
 import Data.Data
 import Data.Functor.Contravariant
+import Data.Hashable
+import qualified Data.HashMap.Strict as HashMap
 import Data.Monoid
 import Data.Serialize
+import qualified Data.Vector as Vector
 import Data.Word
+import Network.Socket
 import qualified Rank2
+import qualified Text.ParserCombinators.ReadP as RP
 
 import Crypto.Tox
-import Network.Tox.Onion.Transport
+import Data.Tox.Onion
+import qualified Network.Tox.NodeId as UDP
 
 newtype ConId = ConId Word8
     deriving (Eq,Show,Ord,Data,Serialize)
@@ -178,3 +186,40 @@ instance Sized (Welcome Encrypted) where
 instance Serialize (Welcome Encrypted) where
     get = Welcome <$> get <*> get
     put (Welcome n dta) = put n >> put dta
+
+data NodeInfo = NodeInfo
+    { udpNodeInfo :: UDP.NodeInfo
+    , tcpPort     :: PortNumber
+    }
+ deriving (Eq,Ord)
+
+instance Read NodeInfo where
+    readsPrec _ = RP.readP_to_S $ do
+        udp <- RP.readS_to_P reads
+        port <- RP.between (RP.char '{') (RP.char '}') $ do
+                    mapM_ RP.char ("tcp:" :: String)
+                    w16 <- RP.readS_to_P reads
+                    return $ fromIntegral (w16 :: Word16)
+        return $ NodeInfo udp port
+
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo udp port) = case (toJSON udp) of
+        JSON.Object tbl -> JSON.Object $ HashMap.insert "tcp_ports"
+                                                        (JSON.Array $ Vector.fromList
+                                                            [JSON.Number (fromIntegral port)])
+                                                        tbl
+        x               -> x -- Shouldn't happen.
+
+instance FromJSON NodeInfo where
+    parseJSON json = do
+        udp <- parseJSON json
+        port <- case json of
+            JSON.Object v -> do
+                portnum:_ <- v JSON..: "tcp_ports"
+                return  (fromIntegral (portnum :: Word16))
+            _ -> fail "TCP.NodeInfo: Expected JSON object."
+        return $ NodeInfo udp port
+
+instance Hashable NodeInfo where
+    hashWithSalt s n = hashWithSalt s (udpNodeInfo n)
+
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 4e110ec3..0fbbc929 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -134,6 +134,35 @@ partitionTransportM parse encodex tr = do
                 }
     return (xtr, ytr)
 
+partitionAndForkTransport ::
+                      (dst -> msg -> IO ())
+                      -> ((b,a) -> IO (Either (x,xaddr) (b,a)))
+                      -> ((x,xaddr) -> IO (Maybe (Either (msg,dst) (b,a))))
+                      -> Transport err a b
+                      -> IO (Transport err xaddr x, Transport err a b)
+partitionAndForkTransport forkedSend parse encodex tr = do
+    mvar <- newEmptyMVar
+    let xtr = tr { awaitMessage = \kont -> fix $ \again -> do
+                    awaitMessage tr $ \m -> case m of
+                        Just (Right msg) -> parse msg >>=
+                                                either (kont . Just . Right)
+                                                       (\y -> putMVar mvar y >> again)
+                        Just (Left e)    -> kont $ Just (Left e)
+                        Nothing          -> kont Nothing
+                 , sendMessage = \addr' msg' -> do
+                    msg_addr <- encodex (msg',addr')
+                    case msg_addr of
+                        Just (Right (b,a))    -> sendMessage tr a b
+                        Just (Left (msg,dst)) -> forkedSend dst msg
+                        Nothing               -> return ()
+                 }
+        ytr = Transport
+                { awaitMessage   = \kont -> takeMVar mvar >>= kont . Just . Right
+                , sendMessage    = sendMessage tr
+                , closeTransport = return ()
+                }
+    return (xtr, ytr)
+
 -- |
 --      * f add x --> Nothing, consume x
 --                --> Just id, leave x to a different handler
@@ -376,16 +405,27 @@ transactionMethods ::
     TableMethods t tid  -- ^ Table methods to lookup values by /tid/.
     -> (g -> (tid,g))   -- ^ Generate a new unique /tid/ value and update the generator state /g/.
     -> TransactionMethods (g,t (MVar x)) tid addr x
-transactionMethods (TableMethods insert delete lookup) generate = TransactionMethods
+transactionMethods methods generate = transactionMethods' id tryPutMVar methods generate
+
+-- | Like 'transactionMethods' but allows extra information to be stored in the
+-- table of pending transactions.  This also enables multiple 'Client's to
+-- share a single transaction table.
+transactionMethods' ::
+    (MVar x -> a)          -- ^ store MVar into table entry
+    -> (a -> x -> IO void) -- ^ load MVar from table entry
+    -> TableMethods t tid  -- ^ Table methods to lookup values by /tid/.
+    -> (g -> (tid,g))      -- ^ Generate a new unique /tid/ value and update the generator state /g/.
+    -> TransactionMethods (g,t a) tid addr x
+transactionMethods' store load (TableMethods insert delete lookup) generate = TransactionMethods
     { dispatchCancel = \tid (g,t) -> return (g, delete tid t)
     , dispatchRegister = \v _ (g,t) ->
         let (tid,g') = generate g
-            t' = insert tid v t
+            t' = insert tid (store v) t
         in return ( tid, (g',t') )
     , dispatchResponse = \tid x (g,t) ->
         case lookup tid t of
             Just v -> let t' = delete tid t
-                      in return ((g,t'),void $ tryPutMVar v x)
+                      in return ((g,t'),void $ load v x)
             Nothing -> return ((g,t), return ())
     }
 
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index ef74b9c6..6e2a42c5 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveFoldable             #-}
 {-# LANGUAGE DeriveFunctor              #-}
@@ -32,6 +33,7 @@ import qualified Data.ByteString              as B
          ;import Data.ByteString              (ByteString)
 import qualified Data.ByteString.Char8        as C8
 import Data.Data
+import Data.Functor.Identity
 import Data.Functor.Contravariant
 import Data.Maybe
 import qualified Data.MinMaxPSQ               as MinMaxPSQ
@@ -42,6 +44,7 @@ import Network.Socket
 import System.Endian
 import System.IO.Error
 
+import qualified Data.Word64Map
 import Network.BitTorrent.DHT.Token           as Token
 import qualified Data.Wrapper.PSQ             as PSQ
 import System.Global6
@@ -68,6 +71,7 @@ import DebugTag
 import TCPProber
 import Network.Tox.Avahi
 import Network.Tox.Session
+import qualified Data.Tox.Relay as TCP
 import Network.Tox.Relay
 import Network.SessionTransports
 import Network.Kademlia.Search
@@ -238,6 +242,37 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do
             _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
     return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
 
+newOnionClient :: DRG g =>
+                        TransportCrypto
+                        -> Transport String (Onion.OnionDestination RouteId) Onion.Message
+                        -> DHT.Routing
+                        -> TVar SessionTokens
+                        -> TVar Onion.AnnouncedKeys
+                        -> OnionRouter
+                        -> TVar (g, Data.Word64Map.Word64Map a)
+                        -> (MVar Onion.Message -> a)
+                        -> (a -> Onion.Message -> IO void)
+                        -> Client String
+                                  DHT.PacketKind
+                                  DHT.TransactionId
+                                  (Onion.OnionDestination RouteId)
+                                  Onion.Message
+newOnionClient crypto net r toks keydb orouter map_var store load = Client
+    { clientNet = net
+    , clientDispatcher = DispatchMethods
+        { classifyInbound = Onion.classify
+        , lookupHandler   = Onion.handlers net r toks keydb
+        , tableMethods = hookQueries orouter DHT.transactionKey
+                         $ transactionMethods' store load (contramap w64Key w64MapMethods) gen
+        }
+    , clientErrorReporter = logErrors { reportTimeout = reportTimeout ignoreErrors }
+    , clientPending = map_var
+    , clientAddress = getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 r)
+    , clientResponseId = genNonce24 map_var
+    , clientEnterQuery = \_ -> return ()
+    , clientLeaveQuery = \_ _ -> return ()
+    }
+
 newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rendezvous for.
        -> [String]                   -- ^ Bind-address to listen on. Must provide at least one.
        -> ( ContactInfo extra -> SockAddr -> Session -> IO () )
@@ -287,8 +322,11 @@ newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do
     let lookupClose _ = return Nothing
 
     mkrouting <- DHT.newRouting addr crypto updateIP updateIP
-    orouter <- newOnionRouter crypto $ dput XRoutes
-    (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) <- toxTransport crypto orouter lookupClose udp tcp
+    (orouter,otbl) <- newOnionRouter crypto (dput XRoutes)
+    (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes)
+        <- toxTransport crypto orouter lookupClose udp
+                (sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter))
+                tcp
     sessions <- initSessions (sendMessage cryptonet)
 
     let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
@@ -296,7 +334,7 @@ newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do
         tbl6 = DHT.routing6 $ mkrouting (error "missing client")
         updateOnion bkts tr = hookBucketList DHT.toxSpace bkts orouter (trampolinesUDP orouter) tr
     dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id
-                    $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) updateOnion) net
+                    (\client net -> onInbound (DHT.updateRouting client (mkrouting client) updateOnion) net)
 
     hscache <- newHandshakeCache crypto (sendMessage handshakes)
     let sparams = SessionParams
@@ -315,13 +353,13 @@ newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do
     toks <- do
         nil <- nullSessionTokens
         atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids.
-    oniondrg <- drgNew
     let onionnet = layerTransportM (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
-    onionclient <- newClient oniondrg onionnet (const Onion.classify)
-                    (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient))
-                    (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb)
-                    (hookQueries orouter' DHT.transactionKey)
-                    (const id)
+    let onionclient  = newOnionClient crypto onionnet (mkrouting dhtclient) toks keydb orouter' otbl
+                        Right $ \case
+                            Right v -> tryPutMVar v
+                            Left v  -> \_ -> do
+                                dput XUnexpected "TCP-sent onion query got response over UDP?"
+                                return False
 
     return Tox
         { toxDHT            = dhtclient
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
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index e3f5012b..1111d3b8 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -2,7 +2,10 @@
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleContexts #-}
-module Network.Tox.TCP where
+module Network.Tox.TCP
+    ( module Network.Tox.TCP
+    , NodeInfo(..)
+    ) where
 
 import Control.Arrow
 import Control.Concurrent
@@ -46,11 +49,6 @@ import qualified Network.Tox.NodeId as UDP
 withSize :: Sized x => (Size x -> m (p x)) -> m (p x)
 withSize f = case size of len -> f len
 
-data NodeInfo = NodeInfo
-    { udpNodeInfo :: UDP.NodeInfo
-    , tcpPort     :: PortNumber
-    }
- deriving (Eq,Ord)
 
 type NodeId = UDP.NodeId
 
@@ -59,36 +57,6 @@ type NodeId = UDP.NodeId
 instance Show NodeInfo where
     show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}"
 
-instance Read NodeInfo where
-    readsPrec _ = RP.readP_to_S $ do
-        udp <- RP.readS_to_P reads
-        port <- RP.between (RP.char '{') (RP.char '}') $ do
-                    mapM_ RP.char ("tcp:" :: String)
-                    w16 <- RP.readS_to_P reads
-                    return $ fromIntegral (w16 :: Word16)
-        return $ NodeInfo udp port
-
-instance ToJSON NodeInfo where
-    toJSON (NodeInfo udp port) = case (toJSON udp) of
-        JSON.Object tbl -> JSON.Object $ HashMap.insert "tcp_ports"
-                                                        (JSON.Array $ Vector.fromList
-                                                            [JSON.Number (fromIntegral port)])
-                                                        tbl
-        x               -> x -- Shouldn't happen.
-
-instance FromJSON NodeInfo where
-    parseJSON json = do
-        udp <- parseJSON json
-        port <- case json of
-            JSON.Object v -> do
-                portnum:_ <- v JSON..: "tcp_ports"
-                return  (fromIntegral (portnum :: Word16))
-            _ -> fail "TCP.NodeInfo: Expected JSON object."
-        return $ NodeInfo udp port
-
-instance Hashable NodeInfo where
-    hashWithSalt s n = hashWithSalt s (udpNodeInfo n)
-
 nodeId :: NodeInfo -> NodeId
 nodeId ni = UDP.nodeId $ udpNodeInfo ni
 
@@ -275,12 +243,21 @@ tcpPing client dst = sendQuery client meth () dst
 
 type RelayClient = Client String () Nonce8 NodeInfo RelayPacket
 
-newClient :: TransportCrypto -> IO RelayClient
-newClient crypto = do
+-- | Create a new TCP relay client.  Because polymorphic existential record
+-- updates are currently hard with GHC, this function accepts parameters for
+-- generalizing the table-entry type for pending transactions.  Safe trivial
+-- defaults are 'id' and 'tryPutMVar'.  The resulting customized table state
+-- will be returned to the caller along with the new client.
+newClient :: TransportCrypto
+               -> (MVar RelayPacket -> a)       -- ^ store mvar for query
+               -> (a -> RelayPacket -> IO void) -- ^ load mvar for query
+               -> IO ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a)
+                     , Client String () Nonce8 NodeInfo RelayPacket)
+newClient crypto store load = do
     net <- toxTCP crypto
     drg <- drgNew
     map_var <- atomically $ newTVar (drg, Data.Word64Map.empty)
-    return Client
+    return $ (,) map_var Client
         { clientNet = net
         , clientDispatcher = DispatchMethods
             { classifyInbound = \case
@@ -294,7 +271,7 @@ newClient crypto = do
                     , methodSerialize = \n8 src dst () -> RelayPong n8
                     , methodAction    = \src () -> return ()
                     }
-            , tableMethods = transactionMethods (contramap (\(Nonce8 w64) -> w64) w64MapMethods)
+            , tableMethods = transactionMethods' store load (contramap (\(Nonce8 w64) -> w64) w64MapMethods)
                                 $ first (either error Nonce8 . decode) . randomBytesGenerate 8
             }
         , clientErrorReporter = logErrors
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index e79e4d8b..217d5b1d 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -10,7 +10,8 @@ module Network.Tox.Transport (toxTransport, RouteId) where
 
 import Network.QueryResponse
 import Crypto.Tox
-import Network.Tox.DHT.Transport
+import Data.Tox.Relay as TCP
+import Network.Tox.DHT.Transport as UDP
 import Network.Tox.Onion.Transport
 import Network.Tox.Crypto.Transport
 import OnionRouter
@@ -20,20 +21,23 @@ import Network.Socket
 toxTransport ::
       TransportCrypto
           -> OnionRouter
-          -> (PublicKey -> IO (Maybe NodeInfo))
+          -> (PublicKey -> IO (Maybe UDP.NodeInfo))
           -> UDPTransport
-          -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-bound callback.
+          -> (TCP.NodeInfo -> RelayPacket -> IO ())   -- ^ TCP server-bound callback.
+          -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
           -> IO ( Transport String SockAddr (CryptoPacket Encrypted)
-                , Transport String NodeInfo (DHTMessage Encrypted8)
+                , Transport String UDP.NodeInfo (DHTMessage Encrypted8)
                 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                 , Transport String AnnouncedRendezvous (PublicKey,OnionData)
                 , Transport String SockAddr (Handshake Encrypted))
-toxTransport crypto orouter closeLookup udp tcp = do
+toxTransport crypto orouter closeLookup udp tcp2server tcp2client = do
     (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
-    (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp0 tcp
-    (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
-                                        (encodeOnionAddr crypto $ lookupRoute orouter)
-                                        udp1
+    (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr)
+                                    $ forwardOnions crypto udp0 tcp2client
+    (onion1,udp2) <- partitionAndForkTransport tcp2server
+                             (parseOnionAddr $ lookupSender orouter)
+                             (encodeOnionAddr crypto $ lookupRoute orouter)
+                             udp1
     (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1
     let handshakes = layerTransport parseHandshakes encodeHandshakes udp2
     return ( netcrypto