From 6b822e47e4995e4aaf4cb1cc034c34314bd51da2 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 20 Sep 2017 20:47:10 -0400 Subject: Added outbound initiation addresses to the Onion transport. --- src/Network/Tox.hs | 3 +- src/Network/Tox/Crypto/Transport.hs | 1 + src/Network/Tox/DHT/Transport.hs | 1 + src/Network/Tox/Onion/Handlers.hs | 20 ++++++------- src/Network/Tox/Onion/Transport.hs | 57 +++++++++++++++++++++---------------- src/Network/Tox/Transport.hs | 2 +- 6 files changed, 47 insertions(+), 37 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 17585dfd..7893d84a 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -235,7 +235,8 @@ newTox keydb addr = do atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. oniondrg <- drgNew let onionnet = layerTransport (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt - onionclient <- newClient oniondrg onionnet Onion.classify (const $ return $ Onion.OnionToMe addr) + onionclient <- newClient oniondrg onionnet Onion.classify + (const $ return $ either (const $ error "bad sockaddr") Onion.OnionDestination $ nodeInfo zeroID addr) (Onion.handlers onionnet routing toks keydb) (const id) return Tox diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 09f7fda8..851de5d9 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs @@ -19,6 +19,7 @@ import Data.ByteString import Data.Word import Crypto.Hash + data NetCrypto = NetHandshake (Handshake Encrypted) | NetCrypto (CryptoPacket Encrypted) diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 5e20709b..187e23f2 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs @@ -24,6 +24,7 @@ module Network.Tox.DHT.Transport , encrypt , decrypt , dhtMessageType + , asymNodeInfo ) where import Network.Tox.NodeId diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs index 9dc6177c..72398735 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 OnionToOwner Message +type Client = QR.Client String PacketKind TransactionId OnionDestination 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 -> OnionToOwner -> AnnounceRequest -> IO AnnounceResponse +announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination -> AnnounceRequest -> IO AnnounceResponse announceH routing toks keydb (OnionToOwner naddr retpath) req = do case () of _ | announcePingId req == zeros32 @@ -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 (OnionToOwner {}) | storing -> Acknowledged newtok - Just (OnionToOwner ni _) -> SendBackKey $ id2key (nodeId ni) + Nothing -> NotStored newtok + Just (OnionDestination {}) | storing -> Acknowledged newtok + Just (OnionToOwner 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 OnionToOwner (OnionMessage f) + -> Transport err OnionDestination (OnionMessage f) -> addr -> OnionMessage f -> IO () @@ -118,11 +118,11 @@ type NodeDistance = NodeId data AnnouncedKeys = AnnouncedKeys { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds - , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,OnionToOwner)) + , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,OnionDestination)) } -insertKey :: POSIXTime -> NodeId -> OnionToOwner -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys +insertKey :: POSIXTime -> NodeId -> OnionDestination -> 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 +134,12 @@ areq :: Message -> Either String AnnounceRequest areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym areq _ = Left "Unexpected non-announce OnionMessage" -handlers :: Transport err OnionToOwner Message +handlers :: Transport err OnionDestination Message -> Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> PacketKind - -> Maybe (MethodHandler String TransactionId OnionToOwner Message) + -> Maybe (MethodHandler String TransactionId OnionDestination 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 8c4df694..a521c39e 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs @@ -19,7 +19,7 @@ module Network.Tox.Onion.Transport ( parseOnionAddr , encodeOnionAddr , forwardOnions - , OnionToOwner(..) + , OnionDestination(..) , OnionMessage(..) , DataToRoute(..) , AnnounceResponse(..) @@ -41,7 +41,7 @@ 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) +import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo,DHTPublicKey,asymNodeInfo) import Debug.Trace import Control.Arrow @@ -87,11 +87,11 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8)) , Show (f DataToRoute) ) => Show (OnionMessage f) -data OnionToOwner = OnionToOwner NodeInfo (ReturnPath N3) - | OnionToMe SockAddr -- SockAddr is immediate peer in route +data OnionDestination = OnionToOwner NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us. + | OnionDestination NodeInfo -- ^ Our own onion-path. deriving Show -onionKey :: OnionToOwner -> Maybe PublicKey +onionKey :: OnionDestination -> Maybe PublicKey onionKey (OnionToOwner ni _) = Just $ id2key (nodeId ni) onionKey _ = Nothing @@ -120,7 +120,7 @@ instance Serialize (OnionMessage Encrypted) where 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 a -> ReturnPath N3 -> SockAddr -> Either String OnionDestination onionToOwner assym ret3 saddr = do ni <- nodeInfo (key2id $ senderKey assym) saddr return $ OnionToOwner ni ret3 @@ -131,18 +131,18 @@ onion :: Sized msg => ByteString -> SockAddr -> Get (Assym (Encrypted msg) -> t) - -> Either String (t, OnionToOwner) + -> 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,OnionToOwner) (ByteString,SockAddr) +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 . (, OnionToMe saddr)) + 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 @@ -154,22 +154,28 @@ 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,OnionToOwner) -> (ByteString, SockAddr) +encodeOnionAddr :: (OnionMessage Encrypted,OnionDestination) -> (ByteString, SockAddr) encodeOnionAddr (msg,OnionToOwner ni p) = ( runPut $ putResponse (OnionResponse p msg) , nodeAddr ni ) -encodeOnionAddr (msg,OnionToMe a) = ( runPut (putOnionMsg msg), a) +encodeOnionAddr (msg,OnionDestination a) = ( runPut (putOnionMsg msg), nodeAddr a) -- TODO: Construct (OnionRequest N0)? -forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a +forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport 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 @@ -520,26 +526,27 @@ instance Sized OnionData where -- 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 +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 => - 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 + SecretKey -> PublicKey -> Nonce24 -> a -> Encrypted a +encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain where - secret = computeSharedSecret (transportSecret crypto) destKey n - plain = encodePlain $ runIdentity $ x + secret = computeSharedSecret skey destKey n + plain = encodePlain a -decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionToOwner -> Either String (OnionMessage Identity, OnionToOwner) +decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination -> Either String (OnionMessage Identity, OnionDestination) decrypt crypto msg addr = (, addr) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg) decryptMessage :: Serialize x => diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs index 24bd60b7..d99b6713 100644 --- a/src/Network/Tox/Transport.hs +++ b/src/Network/Tox/Transport.hs @@ -21,7 +21,7 @@ toxTransport :: -> (PublicKey -> IO (Maybe NodeInfo)) -> UDPTransport -> IO ( Transport String NodeInfo (DHTMessage Encrypted8) - , Transport String OnionToOwner (OnionMessage Encrypted) + , Transport String OnionDestination (OnionMessage Encrypted) , Transport String SockAddr NetCrypto ) toxTransport crypto closeLookup udp = do (dht,udp1) <- partitionTransport parseDHTAddr encodeDHTAddr id $ forwardOnions crypto udp -- cgit v1.2.3