WIP: Support for sending onion queries to TCP relays.

2 files changed, 1074 insertions, 1 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)
+