3 files changed, 52 insertions, 9 deletions

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)