summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs8
-rw-r--r--src/Network/Tox.hs4
-rw-r--r--src/Network/Tox/Onion/Handlers.hs44
-rw-r--r--src/Network/Tox/Onion/Transport.hs12
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
689 . Tox.GetNodes) 689 . Tox.GetNodes)
690 show -- NodeInfo 690 show -- NodeInfo
691 (const Nothing)) 691 (const Nothing))
692 , ("toxid", DHTQuery (Tox.toxidSearch (Tox.onionTimeout tox) $ Tox.toxOnion tox) 692 , ("toxid", DHTQuery (Tox.toxidSearch (Tox.onionTimeout tox)
693 (Tox.toxCryptoKeys tox)
694 (Tox.toxOnion tox))
693 -- qhandler :: ni -> nid -> IO ([ni], [r], tok) 695 -- qhandler :: ni -> nid -> IO ([ni], [r], tok)
694 (\ni nid -> 696 (\ni nid ->
695 -- _todo :: IO Tox.AnnounceResponse 697 Tox.unwrapAnnounceResponse Nothing
696 -- -> IO ([Tox.NodeInfo], [Crypto.PubKey.Curve25519.PublicKey], b0)
697 Tox.unwrapAnnounceResponse
698 <$> clientAddress (Tox.toxDHT tox) Nothing 698 <$> clientAddress (Tox.toxDHT tox) Nothing
699 <*> Tox.announceH (Tox.toxRouting tox) 699 <*> Tox.announceH (Tox.toxRouting tox)
700 (Tox.toxTokens tox) 700 (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
245getOnionAlias crypto dhtself remoteNode = atomically $ do 245getOnionAlias crypto dhtself remoteNode = atomically $ do
246 ni <- dhtself 246 ni <- dhtself
247 let alias = case remoteNode of 247 let alias = case remoteNode of
248 Just (Onion.OnionDestination (Onion.AnnouncingAlias uk) _ _) 248 Just (Onion.OnionDestination (Onion.AnnouncingAlias _ uk) _ _)
249 -> ni { nodeId = uk } 249 -> ni { nodeId = key2id uk }
250 _ -> ni { nodeId = key2id (onionAliasPublic crypto) } 250 _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
251 return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing 251 return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
252 252
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
167 167
168 168
169toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 169toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
170 -> TransportCrypto
170 -> Client r 171 -> Client r
171 -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo Rendezvous 172 -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo Rendezvous
172toxidSearch getTimeout client = Search 173toxidSearch getTimeout crypto client = Search
173 { searchSpace = toxSpace 174 { searchSpace = toxSpace
174 , searchNodeAddress = nodeIP &&& nodePort 175 , searchNodeAddress = nodeIP &&& nodePort
175 , searchQuery = getRendezvous getTimeout client 176 , searchQuery = getRendezvous getTimeout crypto client
176 -- TODO: We're using SearchingAlias for all searches. When searching
177 -- for nodes to announce at, we should probably use AnnouncingAlias so
178 -- that the token pingid resulting from the search can be used to
179 -- announce.
180 } 177 }
181 178
182announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 179announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
@@ -205,12 +202,12 @@ announceSerializer getTimeout = MethodSerializer
205 _ -> Nothing 202 _ -> Nothing
206 } 203 }
207 204
208unwrapAnnounceResponse :: NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32) 205unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
209unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns)) 206unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns))
210 = case is_stored of 207 = case is_stored of
211 NotStored n32 -> (ns, [], Just n32) 208 NotStored n32 -> ( ns , [] , Just n32)
212 SendBackKey k -> (ns, [Rendezvous k ni], Nothing) 209 SendBackKey k -> ( ns , [Rendezvous k ni] , Nothing )
213 Acknowledged n32 -> (ns, [], Just n32) 210 Acknowledged n32 -> ( ns , maybeToList $ fmap (\k -> Rendezvous (id2key k) ni) alias , Just n32)
214 211
215-- TODO Announce key to announce peers. 212-- TODO Announce key to announce peers.
216-- 213--
@@ -245,14 +242,30 @@ sendOnion getTimeout client req oaddr unwrap =
245 (return . Just . unwrap (onionNodeInfo oaddr)) 242 (return . Just . unwrap (onionNodeInfo oaddr))
246 $ join mb 243 $ join mb
247 244
245selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
246selectAlias crypto pkey = do
247 ks <- filter (\(sk,pk) -> pk == id2key pkey)
248 <$> readTVar (userKeys crypto)
249 maybe (return SearchingAlias)
250 (return . uncurry AnnouncingAlias)
251 (listToMaybe ks)
252
248getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 253getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
254 -> TransportCrypto
249 -> Client r 255 -> Client r
250 -> NodeId 256 -> NodeId
251 -> NodeInfo 257 -> NodeInfo
252 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32)) 258 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
253getRendezvous getTimeout client nid ni = do 259getRendezvous getTimeout crypto client nid ni = do
254 let oaddr = OnionDestination SearchingAlias ni Nothing 260 asel <- atomically $ selectAlias crypto nid
255 sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) oaddr unwrapAnnounceResponse 261 let oaddr = OnionDestination asel ni Nothing
262 rkey = case asel of
263 SearchingAlias -> Nothing
264 _ -> Just $ key2id $ rendezvousPublic crypto
265 sendOnion getTimeout client
266 (AnnounceRequest zeros32 nid $ fromMaybe zeroID rkey)
267 oaddr
268 (unwrapAnnounceResponse rkey)
256 269
257putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 270putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
258 -> TransportCrypto 271 -> TransportCrypto
@@ -265,6 +278,7 @@ putRendezvous getTimeout crypto client pubkey nonce32 ni = do
265 let longTermKey = key2id pubkey 278 let longTermKey = key2id pubkey
266 rkey = rendezvousPublic crypto 279 rkey = rendezvousPublic crypto
267 rendezvousKey = key2id rkey 280 rendezvousKey = key2id rkey
268 let oaddr = OnionDestination (AnnouncingAlias longTermKey) ni Nothing 281 asel <- atomically $ selectAlias crypto longTermKey
282 let oaddr = OnionDestination asel ni Nothing
269 sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr 283 sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr
270 $ \ni resp -> (Rendezvous rkey ni, resp) 284 $ \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
101msgNonce (OnionToRoute _ a) = assymNonce a 101msgNonce (OnionToRoute _ a) = assymNonce a
102msgNonce (OnionToRouteResponse a) = assymNonce a 102msgNonce (OnionToRouteResponse a) = assymNonce a
103 103
104data AliasSelector = SearchingAlias | AnnouncingAlias NodeId 104data AliasSelector = SearchingAlias | AnnouncingAlias SecretKey PublicKey
105 deriving (Eq,Ord,Show) 105 deriving (Eq,Show)
106 106
107data OnionDestination r 107data OnionDestination r
108 = OnionToOwner 108 = OnionToOwner
@@ -611,12 +611,8 @@ instance Sized OnionData where
611 611
612 612
613selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) 613selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey)
614selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias pkey) _ _) 614selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _)
615 = atomically $ do ks <- filter (\(sk,pk) -> pk == id2key pkey) 615 = return (skey, pkey)
616 <$> readTVar (userKeys crypto)
617 maybe (return $ aliasKey crypto rpath)
618 return
619 (listToMaybe ks)
620selectKey crypto msg rpath = return $ aliasKey crypto rpath 616selectKey crypto msg rpath = return $ aliasKey crypto rpath
621 617
622encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r) 618encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r)