summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Onion/Handlers.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-10-18 20:55:56 -0400
committerjoe <joe@jerkface.net>2017-10-18 20:55:56 -0400
commit3b8c8d74db95fa8dc345a73101d2c1921655c70d (patch)
tree3227ac1e43e7222ea2bf5e53c6b502e9a7838b9b /src/Network/Tox/Onion/Handlers.hs
parent35aed24bdd67cecbd77e0c64c6c054e736aac787 (diff)
WIP: Command to publish a toxid on a given node.
Diffstat (limited to 'src/Network/Tox/Onion/Handlers.hs')
-rw-r--r--src/Network/Tox/Onion/Handlers.hs37
1 files changed, 30 insertions, 7 deletions
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,
166toxidSearch getTimeout client = Search 166toxidSearch getTimeout client = Search
167 { searchSpace = toxSpace 167 { searchSpace = toxSpace
168 , searchNodeAddress = nodeIP &&& nodePort 168 , searchNodeAddress = nodeIP &&& nodePort
169 , searchQuery = announce getTimeout client 169 , searchQuery = getRendezvous getTimeout client
170 } 170 }
171 171
172announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 172announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
@@ -221,16 +221,39 @@ unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
221-- started. 221-- started.
222 222
223 223
224announce :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 224sendOnion :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
225 -> Client r 225 -> Client r
226 -> NodeId 226 -> AnnounceRequest
227 -> NodeInfo 227 -> NodeInfo
228 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32)) 228 -> (NodeInfo -> AnnounceResponse -> t)
229announce getTimeout client nid ni = 229 -> IO (Maybe t)
230sendOnion getTimeout client req ni unwrap =
230 -- Four tries and then we tap out. 231 -- Four tries and then we tap out.
231 flip fix 4 $ \loop n -> do 232 flip fix 4 $ \loop n -> do
232 let oaddr = OnionDestination ni Nothing 233 let oaddr = OnionDestination ni Nothing
233 mb <- QR.sendQuery client (announceSerializer getTimeout) (AnnounceRequest zeros32 nid zeroID) oaddr 234 mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr
234 maybe (if n>0 then loop $! n - 1 else return Nothing) 235 maybe (if n>0 then loop $! n - 1 else return Nothing)
235 (return . Just . unwrapAnnounceResponse ni) 236 (return . Just . unwrap ni)
236 $ join mb 237 $ join mb
238
239getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
240 -> Client r
241 -> NodeId
242 -> NodeInfo
243 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
244getRendezvous getTimeout client nid ni =
245 sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) ni unwrapAnnounceResponse
246
247putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
248 -> TransportCrypto
249 -> Client r
250 -> PublicKey
251 -> Nonce32
252 -> NodeInfo
253 -> IO (Maybe (Rendezvous, AnnounceResponse))
254putRendezvous getTimeout crypto client pubkey nonce32 ni = do
255 let longTermKey = key2id pubkey
256 rkey = rendezvousPublic crypto
257 rendezvousKey = key2id rkey
258 sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) ni
259 $ \ni resp -> (Rendezvous rkey ni, resp)