diff options
-rw-r--r-- | src/Network/BitTorrent/DHT/Query.hs | 10 | ||||
-rw-r--r-- | src/Network/DHT/Routing.hs | 4 | ||||
-rw-r--r-- | src/Network/DatagramServer.hs | 16 |
3 files changed, 15 insertions, 15 deletions
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index ae072db0..9162abdc 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs | |||
@@ -259,7 +259,7 @@ isearch f ih = do | |||
259 | tid <- myThreadId | 259 | tid <- myThreadId |
260 | labelThread tid ("search."++show ih) | 260 | labelThread tid ("search."++show ih) |
261 | Search.search s | 261 | Search.search s |
262 | -- atomically $ readTVar (Search.searchResults s) | 262 | -- atomically \$ readTVar (Search.searchResults s) |
263 | return (a, s) | 263 | return (a, s) |
264 | 264 | ||
265 | 265 | ||
@@ -298,11 +298,11 @@ refreshNodes nid = do | |||
298 | $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid))) | 298 | $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid))) |
299 | nodes <- getClosest nid | 299 | nodes <- getClosest nid |
300 | do | 300 | do |
301 | -- forM (L.take 1 nodes) $ \ addr -> do | 301 | -- forM (L.take 1 nodes) \$ \ addr -> do |
302 | -- NodeFound ns <- FindNode nid <@> addr | 302 | -- NodeFound ns <- FindNode nid <@> addr |
303 | -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) () | 303 | -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) () |
304 | -- Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) () | 304 | -- Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) () |
305 | -- nss <- sourceList [[addr]] $= search nid (findNodeQ nid) $$ C.consume | 305 | -- nss <- sourceList [[addr]] \$= search nid (findNodeQ nid) $$ C.consume |
306 | nss <- sourceList [nodes] $= search nid (findNodeQ nid) $$ C.consume | 306 | nss <- sourceList [nodes] $= search nid (findNodeQ nid) $$ C.consume |
307 | $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes." | 307 | $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes." |
308 | _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do | 308 | _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do |
@@ -310,7 +310,7 @@ refreshNodes nid = do | |||
310 | pingQ (nodeAddr n) | 310 | pingQ (nodeAddr n) |
311 | -- pingQ takes care of inserting the node. | 311 | -- pingQ takes care of inserting the node. |
312 | return () | 312 | return () |
313 | return () -- $ L.concat nss | 313 | return () -- \$ L.concat nss |
314 | 314 | ||
315 | -- | This operation do not block but acquire exclusive access to | 315 | -- | This operation do not block but acquire exclusive access to |
316 | -- routing table. | 316 | -- routing table. |
@@ -398,7 +398,7 @@ queryNode' addr q = do | |||
398 | let read_only = False -- TODO: check for NAT issues. (BEP 43) | 398 | let read_only = False -- TODO: check for NAT issues. (BEP 43) |
399 | let KRPC.Method name = KRPC.method :: KRPC.Method (Query a) (Response b) | 399 | let KRPC.Method name = KRPC.method :: KRPC.Method (Query a) (Response b) |
400 | (Response remoteId r, witnessed_ip) <- query' name (toSockAddr addr) (Query nid read_only q) | 400 | (Response remoteId r, witnessed_ip) <- query' name (toSockAddr addr) (Query nid read_only q) |
401 | -- $(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip) | 401 | -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip) |
402 | -- <> " by " <> T.pack (show (toSockAddr addr)) | 402 | -- <> " by " <> T.pack (show (toSockAddr addr)) |
403 | _ <- insertNode (NodeInfo remoteId addr ()) witnessed_ip | 403 | _ <- insertNode (NodeInfo remoteId addr ()) witnessed_ip |
404 | return (remoteId, r, witnessed_ip) | 404 | return (remoteId, r, witnessed_ip) |
diff --git a/src/Network/DHT/Routing.hs b/src/Network/DHT/Routing.hs index 1d1aa44b..5c6abe5d 100644 --- a/src/Network/DHT/Routing.hs +++ b/src/Network/DHT/Routing.hs | |||
@@ -253,12 +253,12 @@ insertBucket curTime (TryInsert info) bucket | |||
253 | guard (t < curTime - delta) | 253 | guard (t < curTime - delta) |
254 | return n | 254 | return n |
255 | -- All stale: | 255 | -- All stale: |
256 | -- map key $ PSQ.atMost (curTime - delta) $ bktNodes bucket | 256 | -- map key \$ PSQ.atMost (curTime - delta) $ bktNodes bucket |
257 | 257 | ||
258 | already_have = maybe False (const True) $ PSQ.lookup info (bktNodes bucket) | 258 | already_have = maybe False (const True) $ PSQ.lookup info (bktNodes bucket) |
259 | 259 | ||
260 | map_ns f = bucket { bktNodes = f (bktNodes bucket) } | 260 | map_ns f = bucket { bktNodes = f (bktNodes bucket) } |
261 | -- map_q f = bucket { bktQ = runIdentity $ f (bktQ bucket) } | 261 | -- map_q f = bucket { bktQ = runIdentity \$ f (bktQ bucket) } |
262 | 262 | ||
263 | insertBucket curTime (PingResult bad_node got_response) bucket | 263 | insertBucket curTime (PingResult bad_node got_response) bucket |
264 | = pure ([], Bucket (upd $ bktNodes bucket) popped) | 264 | = pure ([], Bucket (upd $ bktNodes bucket) popped) |
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs index 5c77fb86..cd74f589 100644 --- a/src/Network/DatagramServer.hs +++ b/src/Network/DatagramServer.hs | |||
@@ -526,13 +526,13 @@ handleQuery meth raw q addr = void $ fork $ do | |||
526 | let res' = either buildError Just res | 526 | let res' = either buildError Just res |
527 | ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" | 527 | ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" |
528 | resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString | 528 | resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString |
529 | -- TODO: Generalize this debug print. | 529 | -- TODO: Generalize this debug print. |
530 | -- resbe = either toBEncode toBEncode res | 530 | -- resbe = either toBEncode toBEncode res |
531 | -- $(logOther "q") $ T.unlines | 531 | -- .(logOther "q") \$ T.unlines |
532 | -- [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw) | 532 | -- [ either (const "<unicode-fail>") id \$ T.decodeUtf8' (BL.toStrict $ showBEncode raw) |
533 | -- , "==>" | 533 | -- , "==>" |
534 | -- , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) | 534 | -- , either (const "<unicode-fail>") id \$ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) |
535 | -- ] | 535 | -- ] |
536 | maybe (return ()) (sendMessage sock addr) resbs | 536 | maybe (return ()) (sendMessage sock addr) resbs |
537 | 537 | ||
538 | handleResponse :: ( MonadKRPC h m raw msg | 538 | handleResponse :: ( MonadKRPC h m raw msg |
@@ -568,7 +568,7 @@ listener p = do | |||
568 | handle exceptions $ BS.recvFrom sock (optMaxMsgSize options) | 568 | handle exceptions $ BS.recvFrom sock (optMaxMsgSize options) |
569 | case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of | 569 | case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of |
570 | Left e -> -- XXX: Send parse failure message? | 570 | Left e -> -- XXX: Send parse failure message? |
571 | -- liftIO $ sendMessage sock addr $ encodeHeaders ctx (unknownMessage e) | 571 | -- liftIO \$ sendMessage sock addr $ encodeHeaders ctx (unknownMessage e) |
572 | return () -- Without transaction id, error message isn't very useful. | 572 | return () -- Without transaction id, error message isn't very useful. |
573 | Right (raw,m) -> | 573 | Right (raw,m) -> |
574 | case envelopeClass m of | 574 | case envelopeClass m of |