diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox.hs | 4 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Handlers.hs | 44 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Transport.hs | 12 |
3 files changed, 35 insertions, 25 deletions
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 | |||
245 | getOnionAlias crypto dhtself remoteNode = atomically $ do | 245 | getOnionAlias 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 | ||
169 | toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) | 169 | toxidSearch :: (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 |
172 | toxidSearch getTimeout client = Search | 173 | toxidSearch 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 | ||
182 | announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) | 179 | announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) |
@@ -205,12 +202,12 @@ announceSerializer getTimeout = MethodSerializer | |||
205 | _ -> Nothing | 202 | _ -> Nothing |
206 | } | 203 | } |
207 | 204 | ||
208 | unwrapAnnounceResponse :: NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32) | 205 | unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32) |
209 | unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns)) | 206 | unwrapAnnounceResponse 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 | ||
245 | selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector | ||
246 | selectAlias 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 | |||
248 | getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) | 253 | getRendezvous :: (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)) |
253 | getRendezvous getTimeout client nid ni = do | 259 | getRendezvous 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 | ||
257 | putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) | 270 | putRendezvous :: (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 | |||
101 | msgNonce (OnionToRoute _ a) = assymNonce a | 101 | msgNonce (OnionToRoute _ a) = assymNonce a |
102 | msgNonce (OnionToRouteResponse a) = assymNonce a | 102 | msgNonce (OnionToRouteResponse a) = assymNonce a |
103 | 103 | ||
104 | data AliasSelector = SearchingAlias | AnnouncingAlias NodeId | 104 | data AliasSelector = SearchingAlias | AnnouncingAlias SecretKey PublicKey |
105 | deriving (Eq,Ord,Show) | 105 | deriving (Eq,Show) |
106 | 106 | ||
107 | data OnionDestination r | 107 | data OnionDestination r |
108 | = OnionToOwner | 108 | = OnionToOwner |
@@ -611,12 +611,8 @@ instance Sized OnionData where | |||
611 | 611 | ||
612 | 612 | ||
613 | selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) | 613 | selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) |
614 | selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias pkey) _ _) | 614 | selectKey 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) | ||
620 | selectKey crypto msg rpath = return $ aliasKey crypto rpath | 616 | selectKey crypto msg rpath = return $ aliasKey crypto rpath |
621 | 617 | ||
622 | encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r) | 618 | encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r) |