From fad30ffd5cb4ebba085029626f0be255fc8df237 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 4 Dec 2018 16:16:01 -0500 Subject: Completed TCP getNodes query. --- src/Network/Tox/Onion/Transport.hs | 73 ++++++++++++++++++++++++++++++++------ 1 file changed, 63 insertions(+), 10 deletions(-) (limited to 'src/Network/Tox/Onion/Transport.hs') diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 0cb03718..8918f913 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs @@ -44,14 +44,18 @@ module Network.Tox.Onion.Transport , OnionRoute(..) , N0 , N1 + , N2 , N3 , onionKey , onionAliasSelector , selectAlias , RouteId(..) , routeId - , rewrap , putRequest + , wrapForRoute + , wrapSymmetric + , wrapOnion + , wrapOnionPure ) where import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) @@ -91,6 +95,7 @@ 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 @@ -124,6 +129,26 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8)) , 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 @@ -274,10 +299,10 @@ encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do return x -forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> UDPTransport +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 -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a +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 @@ -325,6 +350,7 @@ data OnionRequest n = OnionRequest deriving (Eq,Ord) +{- instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted)) ) => Data (OnionRequest n) where @@ -336,6 +362,8 @@ instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) #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 @@ -397,7 +425,17 @@ instance (Sized (ReturnPath n)) => Sized (OnionResponse (S n)) where data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a } | TCPIndex { tcpIndex :: Int, unaddressed :: a } - deriving (Eq,Show) + 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 @@ -434,6 +472,10 @@ 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 @@ -549,6 +591,7 @@ instance (Serialize (Encrypted (Addressed (Forwarding n msg)))) => Serialize (Fo get = Forwarding <$> getPublicKey <*> get put (Forwarding k x) = putPublicKey k >> put x +{- rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)), Serialize (ReturnPath n), Serialize @@ -565,6 +608,7 @@ rewrap crypto saddr (OnionRequest nonce msg rpath) = do 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 @@ -584,7 +628,6 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = case peeled of Left e -> do - -- todo report encryption error dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e] kont Right (Addressed dst msg') -> do @@ -617,7 +660,7 @@ handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (Return -> TransportCrypto -> SockAddr -> UDPTransport - -> (Int -> OnionResponse N1 -> IO ()) -- ^ TCP-relay onion send. + -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-relay onion send. -> IO a -> OnionResponse (S n) -> IO a @@ -633,10 +676,9 @@ handleOnionResponse proxy crypto saddr udp sendTCP kont (OnionResponse path msg) sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg) kont Right (TCPIndex dst path') -> do - -- This should only occur for OnionResponse N1 - case gcast (OnionResponse path' msg) of - Just supported -> sendTCP dst supported - Nothing -> dput XUnexpected "handleOnionResponse: TCP-bound message not supported." + case peanoVal path' of + 0 -> sendTCP dst msg + n -> dput XUnexpected $ "handleOnionResponse: TCP-bound OnionResponse" ++ show n ++ " not supported." kont @@ -900,6 +942,17 @@ wrapOnion crypto skey nonce destkey saddr fwd = do 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. -- cgit v1.2.3