From 0a1417e6c6cc2e907a34987d026c168a8ab55b8a Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 15 Sep 2017 04:17:23 -0400 Subject: Moved OnionTransport to its hierarchical location. --- src/Network/Tox/Onion/Transport.hs | 569 +++++++++++++++++++++++++++++++++++++ 1 file changed, 569 insertions(+) create mode 100644 src/Network/Tox/Onion/Transport.hs (limited to 'src/Network/Tox/Onion') diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs new file mode 100644 index 00000000..f10dcb43 --- /dev/null +++ b/src/Network/Tox/Onion/Transport.hs @@ -0,0 +1,569 @@ +{-# 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 + , OnionToOwner(..) + , 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.Address +import qualified Crypto.Tox as ToxCrypto +import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo,DHTPublicKey) + +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 (f DataToRoute)) -- destination key, aliased Assym + | OnionToRouteResponse (Assym (f DataToRoute)) + +deriving instance ( Show (f (AnnounceRequest, Nonce8)) + , Show (f AnnounceResponse) + , Show (f DataToRoute) + ) => Show (OnionMessage f) + +data OnionToOwner = OnionToOwner NodeInfo (ReturnPath N3) + | OnionToMe SockAddr -- SockAddr is immediate peer in route + deriving Show + +onionKey :: OnionToOwner -> 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 OnionToOwner +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, OnionToOwner) +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,OnionToOwner) (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 . (, OnionToMe saddr)) + = 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 + +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,OnionToOwner) -> (ByteString, SockAddr) +encodeOnionAddr (msg,OnionToOwner ni p) = ( runPut $ putResponse (OnionResponse p msg) + , nodeAddr ni ) +encodeOnionAddr (msg,OnionToMe a) = ( runPut (putOnionMsg msg), a) + +forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a +forwardOnions crypto udp = udp { awaitMessage = forwardAwait crypto udp } + +-- forMe :: HandleHi +-- forThem :: handleLo +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 -> OnionToOwner -> (OnionMessage Encrypted, OnionToOwner) +encrypt crypto msg rpath = ( transcode (encryptMessage crypto okey) msg + , rpath) + where + -- 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 => + TransportCrypto -> PublicKey -> Nonce24 -> Either (Identity a) (Assym (Identity a)) -> Encrypted a +encryptMessage crypto destKey n (Right a) = ToxCrypto.encrypt secret plain + where + secret = computeSharedSecret (transportSecret crypto) destKey n + plain = encodePlain $ runIdentity $ assymData a +encryptMessage crypto destKey n (Left x) = ToxCrypto.encrypt secret plain + where + secret = computeSharedSecret (transportSecret crypto) destKey n + plain = encodePlain $ runIdentity $ x + +decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionToOwner -> Either String (OnionMessage Identity, OnionToOwner) +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 (OnionToRoute pub a) = fmap (OnionToRoute pub) $ sequenceA $ fmap uncomposed a +sequenceMessage (OnionToRouteResponse a) = fmap OnionToRouteResponse $ sequenceA $ fmap uncomposed a +sequenceMessage (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 <$> uncomposed dta + +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 (OnionToRoute pub a) = OnionToRoute pub $ a { assymData = f (assymNonce a) (Right a) } +transcode f (OnionToRouteResponse a) = OnionToRouteResponse $ a { assymData = f (assymNonce a) (Right a) } +transcode f (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 $ f n24 $ Left dta + -- cgit v1.2.3