Now searches using store command when we own the key.

This gives us a usable token for storing when the search is complete.

4 files changed, 39 insertions, 29 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index e285d2d2..324146c1 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -689,12 +689,12 @@ main = do
                                                                 . Tox.GetNodes)
                                                         show -- NodeInfo
                                                         (const Nothing))
-                                    , ("toxid", DHTQuery (Tox.toxidSearch (Tox.onionTimeout tox) $ Tox.toxOnion tox)
+                                    , ("toxid", DHTQuery (Tox.toxidSearch (Tox.onionTimeout tox)
+                                                                          (Tox.toxCryptoKeys tox)
+                                                                          (Tox.toxOnion tox))
                                                          -- qhandler :: ni -> nid -> IO ([ni], [r], tok)
                                                          (\ni nid ->
-                                                            -- _todo :: IO Tox.AnnounceResponse
-                                                            --       -> IO ([Tox.NodeInfo], [Crypto.PubKey.Curve25519.PublicKey], b0)
-                                                            Tox.unwrapAnnounceResponse
+                                                            Tox.unwrapAnnounceResponse Nothing
                                                                 <$> clientAddress (Tox.toxDHT tox) Nothing
                                                                 <*> Tox.announceH (Tox.toxRouting tox)
                                                                                   (Tox.toxTokens tox)
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3b5c23a2..908691df 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -245,8 +245,8 @@ getOnionAlias :: TransportCrypto -> STM NodeInfo -> Maybe (Onion.OnionDestinatio
 getOnionAlias crypto dhtself remoteNode = atomically $ do
     ni <- dhtself
     let alias = case remoteNode of
-            Just (Onion.OnionDestination (Onion.AnnouncingAlias uk) _ _)
-              -> ni { nodeId = uk }
+            Just (Onion.OnionDestination (Onion.AnnouncingAlias _ uk) _ _)
+              -> ni { nodeId = key2id uk }
             _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
     return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
 
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index dc7817db..103c216b 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -167,16 +167,13 @@ handlers net _ _ keydb _ = Just $ NoReply Right $ dataToRouteH keydb net
 
 
 toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
+               -> TransportCrypto
                -> Client r
                -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo Rendezvous
-toxidSearch getTimeout client = Search
+toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = getRendezvous getTimeout client
-        -- TODO: We're using SearchingAlias for all searches.  When searching
-        -- for nodes to announce at, we should probably use AnnouncingAlias so
-        -- that the token pingid resulting from the search can be used to
-        -- announce.
+    , searchQuery       = getRendezvous getTimeout crypto client
     }
 
 announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
@@ -205,12 +202,12 @@ announceSerializer getTimeout = MethodSerializer
         _                              -> Nothing
     }
 
-unwrapAnnounceResponse :: NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
-unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
+unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
+unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns))
     = case is_stored of
-        NotStored n32    -> (ns, [],  Just n32)
-        SendBackKey k    -> (ns, [Rendezvous k ni], Nothing)
-        Acknowledged n32 -> (ns, [],  Just n32)
+        NotStored n32    -> ( ns , []                                                        , Just n32)
+        SendBackKey k    -> ( ns , [Rendezvous k ni]                                         , Nothing )
+        Acknowledged n32 -> ( ns , maybeToList $ fmap (\k -> Rendezvous (id2key k) ni) alias , Just n32)
 
 -- TODO Announce key to announce peers.
 --
@@ -245,14 +242,30 @@ sendOnion getTimeout client req oaddr unwrap =
           (return . Just . unwrap (onionNodeInfo oaddr))
           $ join mb
 
+selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
+selectAlias crypto pkey = do
+        ks <- filter (\(sk,pk) -> pk == id2key pkey)
+                                <$> readTVar (userKeys crypto)
+        maybe (return SearchingAlias)
+              (return . uncurry AnnouncingAlias)
+              (listToMaybe ks)
+
 getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
+            -> TransportCrypto
             -> Client r
             -> NodeId
             -> NodeInfo
             -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
-getRendezvous getTimeout client nid ni = do
-    let oaddr = OnionDestination SearchingAlias ni Nothing
-    sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) oaddr unwrapAnnounceResponse
+getRendezvous getTimeout crypto client nid ni = do
+    asel <- atomically $ selectAlias crypto nid
+    let oaddr = OnionDestination asel ni Nothing
+        rkey  = case asel of
+                    SearchingAlias -> Nothing
+                    _              -> Just $ key2id $ rendezvousPublic crypto
+    sendOnion getTimeout client
+        (AnnounceRequest zeros32 nid $ fromMaybe zeroID rkey)
+        oaddr
+        (unwrapAnnounceResponse rkey)
 
 putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
@@ -265,6 +278,7 @@ putRendezvous getTimeout crypto client pubkey nonce32 ni = do
     let longTermKey   = key2id pubkey
         rkey          = rendezvousPublic crypto
         rendezvousKey = key2id rkey
-    let oaddr = OnionDestination (AnnouncingAlias longTermKey) ni Nothing
+    asel <- atomically $ selectAlias crypto longTermKey
+    let oaddr = OnionDestination asel ni Nothing
     sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr
         $ \ni resp -> (Rendezvous rkey ni, resp)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index e52c8faa..82f2c8a7 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -101,8 +101,8 @@ msgNonce (OnionAnnounceResponse _ n24 _) = n24
 msgNonce (OnionToRoute _ a)              = assymNonce a
 msgNonce (OnionToRouteResponse a)        = assymNonce a
 
-data AliasSelector = SearchingAlias | AnnouncingAlias NodeId
-    deriving (Eq,Ord,Show)
+data AliasSelector = SearchingAlias | AnnouncingAlias SecretKey PublicKey
+    deriving (Eq,Show)
 
 data OnionDestination r
     = OnionToOwner
@@ -611,12 +611,8 @@ instance Sized OnionData where
 
 
 selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey)
-selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias pkey) _ _)
-    = atomically $ do ks <- filter (\(sk,pk) -> pk == id2key pkey)
-                                <$> readTVar (userKeys crypto)
-                      maybe (return $ aliasKey crypto rpath)
-                            return
-                            (listToMaybe ks)
+selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _)
+                           = return (skey, pkey)
 selectKey crypto msg rpath = return $ aliasKey crypto rpath
 
 encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r)