From caba20a08600d92d43b57abb51850341ade89dfb Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 1 Apr 2015 15:39:38 -0400 Subject: newNode now accepts optional NodeId to use. --- src/Network/BitTorrent/Client.hs | 2 +- src/Network/BitTorrent/DHT.hs | 2 +- src/Network/BitTorrent/DHT/Query.hs | 2 +- src/Network/BitTorrent/DHT/Session.hs | 5 +++-- 4 files changed, 6 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs index d21b4d1e..b9a59f45 100644 --- a/src/Network/BitTorrent/Client.hs +++ b/src/Network/BitTorrent/Client.hs @@ -114,7 +114,7 @@ initClient opts @ Options {..} logFun = do let mkEx = Exchange.newManager (exchangeOptions pid opts) (connHandler tmap) (_, emgr) <- allocate mkEx Exchange.closeManager - let mkNode = DHT.newNode defaultHandlers def optNodeAddr logFun + let mkNode = DHT.newNode defaultHandlers def optNodeAddr logFun Nothing (_, node) <- allocate mkNode DHT.closeNode resourceMap <- getInternalState diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index 39b33478..7340b854 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs @@ -86,7 +86,7 @@ dht :: Address ip -> IO a -- ^ result. dht opts addr action = do runStderrLoggingT $ LoggingT $ \ logger -> do - bracket (newNode defaultHandlers opts addr logger) closeNode $ + bracket (newNode defaultHandlers opts addr logger Nothing) closeNode $ \ node -> runDHT node action {-# INLINE dht #-} diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index ac53bd91..cb7d5c5f 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs @@ -160,7 +160,7 @@ search k action = do $(logWarnS) "search" "start query" responses <- lift $ queryParallel (action <$> batch) let (nodes, results) = partitionEithers responses - $(logWarnS) "search" "done query" + $(logWarnS) "search" ("done query more:" <> T.pack (show $ L.length nodes)) leftover $ L.concat nodes mapM_ yield results diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index 9aa25866..38b3ed11 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs @@ -299,8 +299,9 @@ newNode :: Address ip -> Options -- ^ various dht options; -> NodeAddr ip -- ^ node address to bind; -> LogFun -- ^ + -> Maybe NodeId -- ^ use this NodeId, if not given a new one is generated. -> IO (Node ip) -- ^ a new DHT node running at given address. -newNode hs opts naddr logger = do +newNode hs opts naddr logger mbid = do s <- createInternalState runInternalState initNode s `onException` closeInternalState s @@ -311,7 +312,7 @@ newNode hs opts naddr logger = do s <- getInternalState (_, m) <- allocate (newManager rpcOpts nodeAddr hs) closeManager liftIO $ do - myId <- genNodeId + myId <- maybe genNodeId return mbid node <- Node opts myId s m <$> newMVar (nullTable myId (optBucketCount opts)) <*> newTVarIO def -- cgit v1.2.3