From 3b8c8d74db95fa8dc345a73101d2c1921655c70d Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 18 Oct 2017 20:55:56 -0400 Subject: WIP: Command to publish a toxid on a given node. --- src/Crypto/Tox.hs | 14 ++++++++++++++ src/Network/Tox.hs | 10 ++++++++-- src/Network/Tox/Onion/Handlers.hs | 37 ++++++++++++++++++++++++++++++------- 3 files changed, 52 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs index d6f63f18..b86a5395 100644 --- a/src/Crypto/Tox.hs +++ b/src/Crypto/Tox.hs @@ -49,6 +49,7 @@ module Crypto.Tox ) where import Control.Arrow +import Control.Monad import qualified Crypto.Cipher.ChaChaPoly1305 as Symmetric import qualified Crypto.Cipher.Salsa as Salsa import qualified Crypto.Cipher.XSalsa as XSalsa @@ -260,6 +261,7 @@ bin2hex = C8.unpack . Base16.encode . BA.convert bin2base64 :: ByteArrayAccess bs => bs -> String bin2base64 = C8.unpack . Base64.encode . BA.convert + instance Show Nonce24 where showsPrec d nonce = quoted (mappend $ bin2hex nonce) @@ -298,6 +300,16 @@ newtype Nonce32 = Nonce32 ByteString instance Show Nonce32 where showsPrec d nonce = mappend $ bin2base64 nonce +instance Read Nonce32 where + readsPrec _ str = either (const []) id $ do + let (ds,ss) = Prelude.splitAt 43 str + ss' <- case ss of + '=':xs -> Right xs -- optional terminating '=' + _ -> Right ss + bs <- Base64.decode (C8.pack $ ds ++ ['=']) + guard $ B.length bs == 32 + return [ (Nonce32 bs, ss') ] + instance Serialize Nonce32 where get = Nonce32 <$> getBytes 32 put (Nonce32 bs) = putByteString bs @@ -350,6 +362,8 @@ data TransportCrypto = TransportCrypto , transportPublic :: PublicKey , onionAliasSecret :: SecretKey , onionAliasPublic :: PublicKey + , rendezvousSecret :: SecretKey + , rendezvousPublic :: PublicKey , transportSymmetric :: STM SymmetricKey , transportNewNonce :: STM Nonce24 } diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 56c4b8e6..98e9691b 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -101,8 +101,10 @@ newCrypto :: IO TransportCrypto newCrypto = do secret <- generateSecretKey alias <- generateSecretKey - let pubkey = toPublic secret - aliaspub = toPublic alias + ralias <- generateSecretKey + let pubkey = toPublic secret + aliaspub = toPublic alias + raliaspub = toPublic ralias (symkey, drg) <- do drg0 <- getSystemDRG return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG) @@ -115,6 +117,8 @@ newCrypto = do , transportPublic = pubkey , onionAliasSecret = alias , onionAliasPublic = aliaspub + , rendezvousSecret = ralias + , rendezvousPublic = raliaspub , transportSymmetric = return $ SymmetricKey symkey , transportNewNonce = do drg1 <- readTVar noncevar @@ -204,6 +208,7 @@ data Tox = Tox , toxOnion :: Onion.Client RouteId , toxToRoute :: Transport String Onion.Rendezvous (Assym (Encrypted Onion.DataToRoute)) , toxCrypto :: Transport String SockAddr NetCrypto + , toxCryptoKeys :: TransportCrypto , toxRouting :: DHT.Routing , toxTokens :: TVar SessionTokens , toxAnnouncedKeys :: TVar Onion.AnnouncedKeys @@ -273,6 +278,7 @@ newTox keydb addr = do , toxOnion = onionclient , toxToRoute = dtacrypt , toxCrypto = cryptonet + , toxCryptoKeys = crypto , toxRouting = routing , toxTokens = toks , toxAnnouncedKeys = keydb diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs index 439de709..9702cbb8 100644 --- a/src/Network/Tox/Onion/Handlers.hs +++ b/src/Network/Tox/Onion/Handlers.hs @@ -166,7 +166,7 @@ toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, toxidSearch getTimeout client = Search { searchSpace = toxSpace , searchNodeAddress = nodeIP &&& nodePort - , searchQuery = announce getTimeout client + , searchQuery = getRendezvous getTimeout client } announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) @@ -221,16 +221,39 @@ unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns)) -- started. -announce :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) +sendOnion :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) -> Client r - -> NodeId + -> AnnounceRequest -> NodeInfo - -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32)) -announce getTimeout client nid ni = + -> (NodeInfo -> AnnounceResponse -> t) + -> IO (Maybe t) +sendOnion getTimeout client req ni unwrap = -- Four tries and then we tap out. flip fix 4 $ \loop n -> do let oaddr = OnionDestination ni Nothing - mb <- QR.sendQuery client (announceSerializer getTimeout) (AnnounceRequest zeros32 nid zeroID) oaddr + mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr maybe (if n>0 then loop $! n - 1 else return Nothing) - (return . Just . unwrapAnnounceResponse ni) + (return . Just . unwrap ni) $ join mb + +getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) + -> Client r + -> NodeId + -> NodeInfo + -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32)) +getRendezvous getTimeout client nid ni = + sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) ni unwrapAnnounceResponse + +putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) + -> TransportCrypto + -> Client r + -> PublicKey + -> Nonce32 + -> NodeInfo + -> IO (Maybe (Rendezvous, AnnounceResponse)) +putRendezvous getTimeout crypto client pubkey nonce32 ni = do + let longTermKey = key2id pubkey + rkey = rendezvousPublic crypto + rendezvousKey = key2id rkey + sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) ni + $ \ni resp -> (Rendezvous rkey ni, resp) -- cgit v1.2.3