From 2e0d1e945c4c0e298176d58cf68df8191b698c1a Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 4 Sep 2017 15:36:25 -0400 Subject: Fleshed out some Onion Transport stubs. --- OnionTransport.hs | 133 +++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 102 insertions(+), 31 deletions(-) diff --git a/OnionTransport.hs b/OnionTransport.hs index d6f6671e..7a837a2b 100644 --- a/OnionTransport.hs +++ b/OnionTransport.hs @@ -35,12 +35,15 @@ import Network.QueryResponse import ToxCrypto hiding (encrypt,decrypt) import ToxAddress import qualified ToxCrypto -import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo) +import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo,DHTPublicKey) import Control.Arrow import qualified Data.ByteString as B ;import Data.ByteString (ByteString) +import Data.Coerce +import Data.Functor.Contravariant import Data.Functor.Identity +import Data.Monoid import Data.Serialize as S import Data.Typeable import Data.Word @@ -69,6 +72,16 @@ data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3) | OnionToMe SockAddr -- SockAddr is immediate peer in route deriving Show +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 onionToOwner :: Assym a -> ReturnPath 3 -> SockAddr -> Either String OnionToOwner onionToOwner assym ret3 saddr = do @@ -94,23 +107,28 @@ parseOnionAddr (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 (OnionAnnounceResponse <$> get <*> get <*> get) bs -- Announce Response - 0x86 -> response $ runGet (OnionToRouteResponse <$> getOnionAssym) bs -- Onion Data Response + 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,addr) = ( runPut (putmsg >> putpath), saddr ) +encodeOnionAddr (msg,addr) = ( runPut (putOnionMsg msg >> putpath), saddr ) where (saddr,putpath) | OnionToOwner ni p <- addr = (nodeAddr ni, put p) | OnionToMe a <- addr = (a, return ()) - putmsg | OnionAnnounce a <- msg = putOnionAssym 0x83 (return ()) a - | OnionToRoute pubkey a <- msg = putOnionAssym 0x85 (putPublicKey pubkey) a - | OnionToRouteResponse a <- msg = putOnionAssym 0x86 (return ()) a - | OnionAnnounceResponse n8 n24 x <- msg = put (0x84 :: Word8) >> put n8 >> put n24 >> put x - forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a forwardOnions crypto udp = udp { awaitMessage = await' } where @@ -128,8 +146,7 @@ forwardOnions crypto udp = udp { awaitMessage = await' } _ -> forThem m m -> forThem m -forward :: forall c b b1. - Serialize b => +forward :: forall c b b1. Serialize b => (Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c forward forMe bs f = either (forMe . Just . Left) f $ decode $ B.tail bs @@ -154,23 +171,44 @@ data OnionResponse (n :: Nat) = OnionResponse , msgToOwner :: OnionMessage Encrypted } -instance ( KnownNat n, Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where - get = OnionResponse <$> get <*> get - put (OnionResponse p m) = put p >> put m +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 } +instance Sized a => Sized (Addressed a) where + size = case size of + ConstSize n -> ConstSize $ 1{-family-} + 16{-ip-} + 2{-port-} + n + VarSize f -> VarSize $ \x -> 1{-family-} + 16{-ip-} + 2{-port-} + f x + data ReturnPath (n :: Nat) where NoReturnPath :: ReturnPath 0 ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath (n - 1))) -> ReturnPath n -instance KnownNat n => Sized (Addressed (ReturnPath n)) where size = _todo --- -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce) +-- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce) +instance KnownNat n => Sized (ReturnPath n) where + size = ConstSize $ 59 * fromIntegral (natVal (Proxy :: Proxy n)) + +instance Serialize (ReturnPath 0) where get = pure NoReturnPath + put NoReturnPath = pure () + +instance Serialize (ReturnPath 1) where get = ReturnPath <$> get <*> get + put (ReturnPath n24 p) = put n24 >> put p +instance Serialize (ReturnPath 2) where get = ReturnPath <$> get <*> get + put (ReturnPath n24 p) = put n24 >> put p + +instance Serialize (ReturnPath 3) 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 n => Show (ReturnPath n) where show rpath = "ReturnPath" ++ show (natVal rpath) @@ -186,9 +224,25 @@ data Forwarding (n :: Nat) msg where NotForwarded :: msg -> Forwarding 0 msg Forwarding :: Assym (Encrypted (Addressed (Forwarding (n - 1) msg))) -> Forwarding n msg -instance (KnownNat n, Sized msg) => Sized (Addressed (Forwarding n msg)) where size = _todo - -instance (Serialize msg, Serialize (Encrypted (Addressed (Forwarding (n - 1) msg)))) => Serialize (Forwarding n msg) where +instance Sized msg => Sized (Forwarding 0 msg) + where size = case size :: Size msg of + ConstSize n -> ConstSize n + VarSize f -> VarSize $ \(NotForwarded x) -> f x +instance Sized msg => Sized (Forwarding 1 msg) + where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 0 msg)))) of + ConstSize n -> ConstSize n + VarSize f -> VarSize $ \(Forwarding a) -> f a +instance Sized msg => Sized (Forwarding 2 msg) + where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 1 msg)))) of + ConstSize n -> ConstSize n + VarSize f -> VarSize $ \(Forwarding a) -> f a +instance Sized msg => Sized (Forwarding 3 msg) + where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 2 msg)))) of + ConstSize n -> ConstSize n + VarSize f -> VarSize $ \(Forwarding a) -> f a + + +instance (Serialize (Encrypted (Addressed (Forwarding (n - 1) msg)))) => Serialize (Forwarding n msg) where get = Forwarding <$> getAliasedAssym put (Forwarding x) = putAliasedAssym x @@ -205,19 +259,28 @@ data AnnounceRequest = AnnounceRequest , announceKey :: NodeId -- Public key that we want those sending back data packets to use } -instance Sized AnnounceRequest where size = _todo +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 3) -getOnionRequest = (,) <$> getAliasedAssym <*> _todo +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 3) of ConstSize n -> cnt - n) + getAliasedAssym + path <- get + return (a,path) data KeyRecord = NotStored Nonce32 | SendBackKey PublicKey | Acknowledged Nonce32 +instance Sized KeyRecord where size = ConstSize 33 + instance S.Serialize KeyRecord where get = do is_stored <- S.get :: S.Get Word8 @@ -235,23 +298,31 @@ data AnnounceResponse = AnnounceResponse } instance Sized AnnounceResponse where - size = VarSize $ \AnnounceResponse {} -> _todo + 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 - , dataToRoute :: Encrypted (Word8,ByteString) + { dataFromKey :: PublicKey -- Real public key of sender + , dataToRoute :: Encrypted OnionData -- (Word8,ByteString) -- DHTPK 0x9c } instance Sized DataToRoute where - size = VarSize $ \DataToRoute {} -> _todo + size = ConstSize 32 <> contramap dataToRoute size instance Serialize DataToRoute where - get = return $ DataToRoute _todo _todo - put _ = return () -- todo + 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) msg, rpath) @@ -264,7 +335,7 @@ encryptMessage crypto n (Right a) = ToxCrypto.encrypt secret plain plain = encodePlain $ runIdentity $ assymData a encryptMessage crypto n (Left x) = ToxCrypto.encrypt secret plain where - secret = computeSharedSecret (transportSecret crypto) _todo n + secret = computeSharedSecret (transportSecret crypto) _todo n -- OnionAnnounceResponse has no sender key plain = encodePlain $ runIdentity $ x decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionToOwner -> Either String (OnionMessage Identity, OnionToOwner) @@ -280,7 +351,7 @@ decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n e = assymData assymE plain = Composed . fmap Identity . (>>= decodePlain) -decryptMessage crypto n (Left e) = _todo +decryptMessage crypto n (Left e) = _todo -- OnionAnnounceResponse has no sender key sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f) -- cgit v1.2.3