From d408e6c3148106c6dbc8afe24a1488619adf34e1 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 1 Oct 2017 05:26:36 -0400 Subject: Ability to send onion messages when given a path. --- src/Network/Tox/Onion/Handlers.hs | 29 ++++--- src/Network/Tox/Onion/Transport.hs | 151 ++++++++++++++++++++++++++----------- 2 files changed, 122 insertions(+), 58 deletions(-) (limited to 'src/Network/Tox/Onion') diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs index 72398735..08f5cabd 100644 --- a/src/Network/Tox/Onion/Handlers.hs +++ b/src/Network/Tox/Onion/Handlers.hs @@ -35,7 +35,7 @@ import Data.Bits import Data.Ord import Data.Functor.Identity -type Client = QR.Client String PacketKind TransactionId OnionDestination Message +type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message type Message = OnionMessage Identity classify :: Message -> MessageClass String PacketKind TransactionId @@ -59,7 +59,7 @@ classify msg = go msg -- The reason for this 20 second timeout in toxcore is that it gives a reasonable -- time (20 to 40 seconds) for a peer to announce himself while taking in count -- all the possible delays with some extra seconds. -announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination -> AnnounceRequest -> IO AnnounceResponse +announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination r -> AnnounceRequest -> IO AnnounceResponse announceH routing toks keydb (OnionToOwner naddr retpath) req = do case () of _ | announcePingId req == zeros32 @@ -76,7 +76,7 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do let storing = (nodeId naddr == announceSeeking req) record <- atomically $ do when (withTok && storing) $ do - let toxpath = OnionToOwner naddr{ nodeId = announceKey req } retpath + let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath -- Note: The following distance calculation assumes that -- our nodeid doesn't change and is the same for both -- routing4 and routing6. @@ -89,16 +89,16 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr else return $ zeros32 let k = case record of - Nothing -> NotStored newtok - Just (OnionDestination {}) | storing -> Acknowledged newtok - Just (OnionToOwner ni _) -> SendBackKey $ id2key (nodeId ni) + Nothing -> NotStored newtok + Just _ | storing -> Acknowledged newtok + Just (AnnouncedRoute ni _) -> SendBackKey $ id2key (nodeId ni) let response = AnnounceResponse k ns hPutStrLn stderr $ unwords ["Announce:", show req, "-reply->", show response] return response dataToRouteH :: TVar AnnouncedKeys - -> Transport err OnionDestination (OnionMessage f) + -> Transport err (OnionDestination r) (OnionMessage f) -> addr -> OnionMessage f -> IO () @@ -111,18 +111,23 @@ dataToRouteH keydb udp _ (OnionToRoute pub assym) = do return rpath forM_ mb $ \rpath -> do -- forward - sendMessage udp rpath $ OnionToRouteResponse assym + sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse assym hPutStrLn stderr $ "Forwarding data-to-route -->"++show k type NodeDistance = NodeId +data AnnouncedRoute = AnnouncedRoute NodeInfo (ReturnPath N3) + +toOnionDestination :: AnnouncedRoute -> OnionDestination r +toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath + data AnnouncedKeys = AnnouncedKeys { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds - , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,OnionDestination)) + , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,AnnouncedRoute)) } -insertKey :: POSIXTime -> NodeId -> OnionDestination -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys +insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys insertKey tm pub toxpath d keydb = AnnouncedKeys { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb) , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of @@ -134,12 +139,12 @@ areq :: Message -> Either String AnnounceRequest areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym areq _ = Left "Unexpected non-announce OnionMessage" -handlers :: Transport err OnionDestination Message +handlers :: Transport err (OnionDestination r) Message -> Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> PacketKind - -> Maybe (MethodHandler String TransactionId OnionDestination Message) + -> Maybe (MethodHandler String TransactionId (OnionDestination r) Message) handlers net routing toks keydb AnnounceType = Just $ MethodHandler areq (\(TransactionId n8 n24) src dst -> OnionAnnounceResponse n8 n24 . Identity) diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 0e6e4954..a3c1950f 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs @@ -33,6 +33,8 @@ module Network.Tox.Onion.Transport , encrypt , decrypt , peelSymmetric + , OnionRoute(..) + , N3 ) where import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) @@ -86,13 +88,14 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8)) , Show (f DataToRoute) ) => Show (OnionMessage f) -data OnionDestination = OnionToOwner NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us. - | OnionDestination NodeInfo -- ^ Our own onion-path. +data OnionDestination r + = OnionToOwner NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us. + | OnionDestination NodeInfo (Maybe r) -- ^ Our own onion-path. deriving Show -onionKey :: OnionDestination -> Maybe PublicKey -onionKey (OnionToOwner ni _) = Just $ id2key (nodeId ni) -onionKey _ = Nothing +onionKey :: OnionDestination r -> Maybe PublicKey +onionKey (OnionToOwner ni _) = Just $ id2key (nodeId ni) +onionKey (OnionDestination ni _) = Just $ id2key (nodeId ni) instance Sized (OnionMessage Encrypted) where size = VarSize $ \case @@ -111,15 +114,14 @@ instance Serialize (OnionMessage Encrypted) where case typ :: Word8 of 0x83 -> OnionAnnounce <$> getAliasedAssym 0x85 -> OnionToRoute <$> getPublicKey <*> getAliasedAssym - 0x84 -> getOnionReply typ - 0x86 -> getOnionReply typ - t -> fail $ "Unknown onion payload: " ++ show t + t -> fail ("Unknown onion payload: " ++ show t) + `fromMaybe` getOnionReply 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 a -> ReturnPath N3 -> SockAddr -> Either String (OnionDestination r) onionToOwner assym ret3 saddr = do ni <- nodeInfo (key2id $ senderKey assym) saddr return $ OnionToOwner ni ret3 @@ -130,36 +132,37 @@ onion :: Sized msg => ByteString -> SockAddr -> Get (Assym (Encrypted msg) -> t) - -> Either String (t, OnionDestination) + -> Either String (t, OnionDestination r) 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) +parseOnionAddr :: (SockAddr -> Nonce8 -> IO (Maybe (NodeInfo,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 = either (const right) Left - response = either (const right) (Left . \msg -> ( msg , replyAlias saddr msg )) + 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 - 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 + _ -> 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 . \(ni,r) -> (msg,OnionDestination ni (Just r))) + maddr + Just (Right msg@(OnionToRouteResponse asym)) -> do + let ni = asymNodeInfo saddr asym + return $ Left (msg, OnionDestination ni Nothing) + _ -> return right + +getOnionReply :: Word8 -> Maybe (Get (OnionMessage Encrypted)) +getOnionReply 0x84 = Just $ OnionAnnounceResponse <$> get <*> get <*> get +getOnionReply 0x86 = Just $ OnionToRouteResponse <$> getOnionAssym +getOnionReply _ = Nothing putOnionMsg :: OnionMessage Encrypted -> Put putOnionMsg (OnionAnnounce a) = putOnionAssym 0x83 (return ()) a @@ -167,10 +170,18 @@ putOnionMsg (OnionToRoute pubkey a) = putOnionAssym 0x85 (putPublicKey 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)? +encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute)) + -> (OnionMessage Encrypted,OnionDestination r) + -> IO (Maybe (ByteString, SockAddr)) +encodeOnionAddr _ (msg,OnionToOwner ni p) = + return $ Just ( runPut $ putResponse (OnionResponse p msg) + , nodeAddr ni ) +encodeOnionAddr _ (msg,OnionDestination _ Nothing ) = return Nothing +encodeOnionAddr getRoute (msg,OnionDestination ni (Just rid)) = do + let go route = do + return (runPut $ putRequest $ wrapForRoute msg ni route, nodeAddr ni) + getRoute ni rid >>= mapM go + forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport forwardOnions crypto udp = udp { awaitMessage = forwardAwait crypto udp } @@ -253,7 +264,8 @@ data OnionResponse n = OnionResponse deriving instance KnownNat (PeanoNat n) => Show (OnionResponse n) instance ( Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where - get = OnionResponse <$> get <*> (get >>= getOnionReply) + get = OnionResponse <$> get <*> (get >>= fromMaybe (fail "illegal onion forwarding") + . getOnionReply) put (OnionResponse p m) = put p >> putOnionMsg m @@ -525,7 +537,7 @@ instance Sized OnionData where -- should be treated as variable sized. VarSize f -> f dhtpk -encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination -> (OnionMessage Encrypted, OnionDestination) +encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> (OnionMessage Encrypted, OnionDestination r) encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData)) . encryptMessage skey okey) msg @@ -545,31 +557,78 @@ encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain 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) +decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> Either String (OnionMessage Identity, OnionDestination r) +decrypt crypto msg addr = do + msg <- sequenceMessage $ transcode (\n -> decryptMessage crypto n . left (senderkey addr)) msg + Right (msg, addr) + +senderkey :: OnionDestination r -> t -> (Maybe PublicKey, t) +senderkey addr e = (onionKey addr, e) decryptMessage :: Serialize x => TransportCrypto -> Nonce24 - -> Either (Encrypted x) (Assym (Encrypted x)) + -> Either (Maybe PublicKey, Encrypted x) + (Assym (Encrypted x)) -> (Either String ∘ Identity) x -decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e +decryptMessage crypto n arg + | Just secret <- msecret = plain $ ToxCrypto.decrypt secret e + | otherwise = Composed $ Left "decryptMessage: Unknown sender" 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 + msecret = do sender <- mkey + Just $ computeSharedSecret (transportSecret crypto) sender n + (mkey,e) = either id (Just . senderKey &&& assymData) arg + plain = Composed . fmap Identity . (>>= decodePlain) sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f) -sequenceMessage (OnionAnnounce a) = fmap OnionAnnounce $ sequenceA $ fmap uncomposed a +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 (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 + +data OnionRoute = OnionRoute + { routeNonce :: Nonce24 + , routeAliasA :: SecretKey + , routeAliasB :: SecretKey + , routeAliasC :: SecretKey + , routeNodeA :: NodeInfo + , routeNodeB :: NodeInfo + , routeNodeC :: NodeInfo + } + +wrapForRoute :: OnionMessage Encrypted -> NodeInfo -> OnionRoute -> OnionRequest N0 +wrapForRoute msg ni r = OnionRequest + { onionNonce = routeNonce r + , onionForward = wrapOnion (routeAliasA r) + (routeNonce r) + (id2key . nodeId $ routeNodeA r) + (nodeAddr $ routeNodeB r) + $ wrapOnion (routeAliasB r) + (routeNonce r) + (id2key . nodeId $ routeNodeB r) + (nodeAddr $ routeNodeC r) + $ wrapOnion (routeAliasC r) + (routeNonce r) + (id2key . nodeId $ routeNodeC r) + (nodeAddr ni) + $ NotForwarded msg + , pathFromOwner = NoReturnPath + } + +wrapOnion :: Serialize (Forwarding n msg) => + SecretKey + -> Nonce24 + -> PublicKey + -> SockAddr + -> Forwarding n msg + -> Forwarding (S n) msg +wrapOnion skey nonce destkey saddr fwd = + Forwarding (toPublic skey) $ encryptMessage skey destkey nonce (Addressed saddr fwd) -- cgit v1.2.3