summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Onion/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Onion/Handlers.hs')
-rw-r--r--src/Network/Tox/Onion/Handlers.hs23
1 files changed, 15 insertions, 8 deletions
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 9702cbb8..047b902d 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -79,9 +79,15 @@ announceH routing toks keydb oaddr req = do
79 let naddr = onionNodeInfo oaddr 79 let naddr = onionNodeInfo oaddr
80 ns <- getNodesH routing naddr (GetNodes (announceSeeking req)) 80 ns <- getNodesH routing naddr (GetNodes (announceSeeking req))
81 tm <- getPOSIXTime 81 tm <- getPOSIXTime
82
82 let storing = case oaddr of 83 let storing = case oaddr of
83 OnionToOwner _ pth -> guard (nodeId naddr == announceSeeking req) >> Just pth 84 OnionToOwner _ pth -> guard (nodeId naddr == announceSeeking req) >> Just pth
84 _ -> Nothing 85 _ -> Nothing
86 hPutStrLn stderr $ unlines [ "announceH: nodeId = " ++ show (nodeId naddr)
87 , " announceSeeking = " ++ show (announceSeeking req)
88 , " withTok = " ++ show withTok
89 , " storing = " ++ maybe "False" (const "True") storing
90 ]
85 record <- atomically $ do 91 record <- atomically $ do
86 forM_ storing $ \retpath -> when withTok $ do 92 forM_ storing $ \retpath -> when withTok $ do
87 let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath 93 let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath
@@ -186,7 +192,7 @@ announceSerializer getTimeout = MethodSerializer
186 { -- The public key is our real long term public key if we want to 192 { -- The public key is our real long term public key if we want to
187 -- announce ourselves, a temporary one if we are searching for 193 -- announce ourselves, a temporary one if we are searching for
188 -- friends. 194 -- friends.
189 senderKey = fromJust $ onionKey src -- TODO: FIXME: this should be a temporary alias key 195 senderKey = onionKey src
190 , assymNonce = n24 196 , assymNonce = n24
191 , assymData = Identity (req, n8) 197 , assymData = Identity (req, n8)
192 } 198 }
@@ -224,16 +230,15 @@ unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
224sendOnion :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 230sendOnion :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
225 -> Client r 231 -> Client r
226 -> AnnounceRequest 232 -> AnnounceRequest
227 -> NodeInfo 233 -> OnionDestination r
228 -> (NodeInfo -> AnnounceResponse -> t) 234 -> (NodeInfo -> AnnounceResponse -> t)
229 -> IO (Maybe t) 235 -> IO (Maybe t)
230sendOnion getTimeout client req ni unwrap = 236sendOnion getTimeout client req oaddr unwrap =
231 -- Four tries and then we tap out. 237 -- Four tries and then we tap out.
232 flip fix 4 $ \loop n -> do 238 flip fix 4 $ \loop n -> do
233 let oaddr = OnionDestination ni Nothing
234 mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr 239 mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr
235 maybe (if n>0 then loop $! n - 1 else return Nothing) 240 maybe (if n>0 then loop $! n - 1 else return Nothing)
236 (return . Just . unwrap ni) 241 (return . Just . unwrap (onionNodeInfo oaddr))
237 $ join mb 242 $ join mb
238 243
239getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 244getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
@@ -241,8 +246,9 @@ getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r
241 -> NodeId 246 -> NodeId
242 -> NodeInfo 247 -> NodeInfo
243 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32)) 248 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
244getRendezvous getTimeout client nid ni = 249getRendezvous getTimeout client nid ni = do
245 sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) ni unwrapAnnounceResponse 250 let oaddr = OnionDestination SearchingAlias ni Nothing
251 sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) oaddr unwrapAnnounceResponse
246 252
247putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 253putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
248 -> TransportCrypto 254 -> TransportCrypto
@@ -255,5 +261,6 @@ putRendezvous getTimeout crypto client pubkey nonce32 ni = do
255 let longTermKey = key2id pubkey 261 let longTermKey = key2id pubkey
256 rkey = rendezvousPublic crypto 262 rkey = rendezvousPublic crypto
257 rendezvousKey = key2id rkey 263 rendezvousKey = key2id rkey
258 sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) ni 264 let oaddr = OnionDestination (AnnouncingAlias longTermKey) ni Nothing
265 sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr
259 $ \ni resp -> (Rendezvous rkey ni, resp) 266 $ \ni resp -> (Rendezvous rkey ni, resp)