path: root/src/Network/Tox/Onion/Transport.hs

{-# LANGUAGE DataKinds                  #-}
{-# 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 TypeFamilyDependencies     #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
module Network.Tox.Onion.Transport
    ( parseOnionAddr
    , encodeOnionAddr
    , forwardOnions
    , OnionDestination(..)
    , OnionMessage(..)
    , DataToRoute(..)
    , AnnounceResponse(..)
    , AnnounceRequest(..)
    , Forwarding(..)
    , ReturnPath(..)
    , OnionRequest(..)
    , OnionResponse(..)
    , Addressed(..)
    , UDPTransport
    , KeyRecord(..)
    , encrypt
    , decrypt
    , peelSymmetric
    ) 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,asymNodeInfo)

import Debug.Trace
import Control.Arrow
import Control.Concurrent.STM
import Control.Monad
import qualified Data.ByteString  as B
         ;import Data.ByteString  (ByteString)
import Data.Coerce
import Data.Function
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.IP
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 System.IO

type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a

type UDPTransport = Transport String SockAddr ByteString


getOnionAssym :: Get (Assym (Encrypted DataToRoute))
getOnionAssym = getAliasedAssym

putOnionAssym :: Serialize a => Word8 -> Put -> Assym a -> Put
putOnionAssym typ p a = put typ >> p >> putAliasedAssym a

data OnionMessage (f :: * -> *)
    = OnionAnnounce (Assym (f (AnnounceRequest,Nonce8)))
    | OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse)
    | OnionToRoute PublicKey (Assym (Encrypted DataToRoute)) -- destination key, aliased Assym
    | OnionToRouteResponse (Assym (Encrypted DataToRoute))

deriving instance ( Show (f (AnnounceRequest, Nonce8))
                  , Show (f AnnounceResponse)
                  , Show (f DataToRoute)
                  ) => Show (OnionMessage f)

data OnionDestination = OnionToOwner NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us.
                      | OnionDestination NodeInfo             -- ^ Our own onion-path.
    deriving Show

onionKey :: OnionDestination -> Maybe PublicKey
onionKey (OnionToOwner ni _) = Just $ id2key (nodeId ni)
onionKey _                   = Nothing

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 <$> getAliasedAssym
            0x85 -> OnionToRoute <$> getPublicKey <*> getAliasedAssym
            0x84 -> getOnionReply typ
            0x86 -> getOnionReply typ
            t    -> fail $ "Unknown onion payload: " ++ show t
    put (OnionAnnounce a)                = putWord8 0x83 >> putAliasedAssym a
    put (OnionToRoute k a)               = putWord8 0x85 >> putPublicKey k >> putAliasedAssym a
    put (OnionAnnounceResponse n8 n24 x) = putWord8 0x84 >> put n8 >> put n24 >> put x
    put (OnionToRouteResponse a)         = putWord8 0x86 >> putAliasedAssym a

onionToOwner :: Assym a -> ReturnPath N3 -> SockAddr -> Either String OnionDestination
onionToOwner assym ret3 saddr = do
    ni <- nodeInfo (key2id $ senderKey assym) saddr
    return $ OnionToOwner ni ret3
-- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr


onion :: Sized msg =>
               ByteString
               -> SockAddr
               -> Get (Assym (Encrypted msg) -> t)
               -> Either String (t, OnionDestination)
onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
                         oaddr <- onionToOwner assym ret3 saddr
                         return (f assym, oaddr)


parseOnionAddr :: (ByteString, SockAddr) -> Either (OnionMessage Encrypted,OnionDestination) (ByteString,SockAddr)
parseOnionAddr (msg,saddr)
    | Just (typ,bs) <- B.uncons msg
    , let right = Right (msg,saddr)
          query = either (const right) Left
          response = either (const right) (Left . \msg -> ( msg , replyAlias saddr msg ))
    = case typ of
    0x83 -> query $ onion bs saddr (pure OnionAnnounce)            -- Announce Request
    0x85 -> query $ onion bs saddr (OnionToRoute <$> getPublicKey) -- Onion Data Request
    0x84 -> response $ runGet (getOnionReply 0x84) bs              -- Announce Response
    0x86 -> response $ runGet (getOnionReply 0x86) bs              -- Onion Data Response
    _ -> right

getOnionReply :: Word8 -> Get (OnionMessage Encrypted)
getOnionReply 0x84 = OnionAnnounceResponse <$> get <*> get <*> get
getOnionReply 0x86 = OnionToRouteResponse <$> getOnionAssym

replyAlias :: SockAddr -> OnionMessage Encrypted -> OnionDestination
replyAlias saddr (OnionAnnounceResponse  _ _ _)
    = OnionDestination
    $ either (error "replyAlias: bad protocol") id
    $ nodeInfo zeroID saddr -- TODO OnionAnnounceResponse has no sender key
replyAlias saddr (OnionToRouteResponse asym)
    = OnionDestination $ asymNodeInfo saddr asym

putOnionMsg :: OnionMessage Encrypted -> Put
putOnionMsg (OnionAnnounce                a) = putOnionAssym 0x83 (return ()) a
putOnionMsg (OnionToRoute pubkey          a) = putOnionAssym 0x85 (putPublicKey pubkey) a
putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
putOnionMsg (OnionToRouteResponse         a) = putOnionAssym 0x86 (return ()) a

encodeOnionAddr :: (OnionMessage Encrypted,OnionDestination) -> (ByteString, SockAddr)
encodeOnionAddr (msg,OnionToOwner ni p) = ( runPut $ putResponse (OnionResponse p msg)
                                          , nodeAddr ni )
encodeOnionAddr (msg,OnionDestination a) = ( runPut (putOnionMsg msg), nodeAddr a) -- TODO: Construct (OnionRequest N0)?

forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport
forwardOnions crypto udp = udp { awaitMessage = forwardAwait crypto udp }

forwardAwait :: TransportCrypto -> UDPTransport -> HandleLo a -> IO a
forwardAwait crypto udp 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 saddr udp another
            0x81 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy  N1) crypto saddr udp another
            0x82 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy  N2) crypto saddr udp another
            0x8c -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N3) crypto saddr udp another
            0x8d -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N2) crypto saddr udp another
            0x8e -> forward kont bs $ handleOnionResponse (Proxy :: Proxy N1) crypto saddr udp 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 = r | r -> 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 instance ( Show (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
                  , KnownNat (PeanoNat n)
                  ) => Show (OnionRequest n)

instance ( Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
         , Sized (ReturnPath n)
         , Serialize (ReturnPath n)
         ) => Serialize (OnionRequest n) where
    get = do
        -- TODO share code with 'getOnionRequest'
        n24 <- 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) = put n >> 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 instance KnownNat (PeanoNat n) => Show (OnionResponse n)

instance ( Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where
    get = OnionResponse <$> get <*> (get >>= getOnionReply)
    put (OnionResponse p m) = put p >> putOnionMsg m


data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
 deriving (Eq,Show)

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

instance Serialize a => Serialize (Addressed a) where
    get = Addressed <$> getForwardAddr <*> get
    put (Addressed addr x) = putForwardAddr addr >> put x

data N0
data S n
type N1 = S N0
type N2 = S N1
type N3 = S N2

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)

-- 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

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

handleOnionRequest :: forall a proxy n.
                      ( LessThanThree n
                      , KnownPeanoNat n
                      , Sized (ReturnPath n)
                      ) => proxy n -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionRequest n -> IO a
handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do
    let n = peanoVal rpath
    hPutStrLn stderr $ "handleOnionRequest " ++ show n
    (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto
                                      <*> transportNewNonce crypto )
    case peelOnion crypto nonce msg of
        Left e -> do
            -- todo report encryption error
            hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), e]
            kont
        Right (Addressed dst msg') -> do
            hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), "SUCCESS"]
            sendMessage udp dst (runPut $ putRequest $ OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath)
            kont

wrapSymmetric :: Serialize (ReturnPath n) =>
                 SymmetricKey -> Nonce24 -> SockAddr -> ReturnPath n -> ReturnPath (S n)
wrapSymmetric sym n saddr rpath = ReturnPath n $ encryptSymmetric sym n (encodePlain $ Addressed 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
              -> Either String (Addressed (Forwarding n t))
peelOnion crypto nonce (Forwarding k fwd) =
    fmap runIdentity $ uncomposed $ decryptMessage crypto nonce (Right $ Assym k nonce fwd)

handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (ReturnPath n)) => proxy (S n) -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionResponse (S n) -> IO a
handleOnionResponse proxy crypto saddr udp kont (OnionResponse path msg) = do
    sym <- atomically $ transportSymmetric crypto
    case peelSymmetric sym path of
        Left e -> do
            -- todo report encryption error
            let n = peanoVal path
            hPutStrLn stderr $ 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


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 (Assym (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)
                 getAliasedAssym
    path <- get
    return (a,path)

putRequest :: (KnownPeanoNat n, Serialize (OnionRequest n)) => OnionRequest n -> Put
putRequest req = do
    putWord8 $ 0x80 + fromIntegral (peanoVal req)
    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

instance S.Serialize AnnounceResponse where
    get = AnnounceResponse <$> S.get <*> S.get
    put (AnnounceResponse st ns) = S.put st >> 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 = OnionDHTPublicKey DHTPublicKey -- 0x9c

instance Sized OnionData where
    size = VarSize $ \(OnionDHTPublicKey dhtpk) -> case size of
            ConstSize n -> n -- Override because OnionData probably
                             -- should be treated as variable sized.
            VarSize f   -> f dhtpk

encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination -> (OnionMessage Encrypted, OnionDestination)
encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData))
                                         . encryptMessage skey okey)
                                       msg
                           , rpath)
    where
        skey = transportSecret crypto

        -- The OnionToMe case shouldn't happen, but we'll use our own public
        -- key in this situation.
        okey = fromMaybe (transportPublic crypto) $ onionKey rpath


encryptMessage :: Serialize a =>
                  SecretKey -> PublicKey -> Nonce24 -> a -> Encrypted a
encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
 where
    secret = computeSharedSecret skey destKey n
    plain  = encodePlain a

decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination -> Either String (OnionMessage Identity, OnionDestination)
decrypt crypto msg addr = (, addr) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg)

decryptMessage :: Serialize x =>
                  TransportCrypto
                  -> Nonce24
                  -> Either (Encrypted x) (Assym (Encrypted x))
                  -> (Either String ∘ Identity) x
decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e
 where
    secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n
    e      = assymData assymE
    plain  = Composed . fmap Identity . (>>= decodePlain)
decryptMessage crypto n (Left e) = _todo -- OnionAnnounceResponse has no sender key


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

transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> OnionMessage f -> OnionMessage g
transcode f (OnionAnnounce a)        = OnionAnnounce        $ a { assymData = f (assymNonce a) (Right a) }
transcode f (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