summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Client.hs2
-rw-r--r--src/Network/BitTorrent/DHT.hs2
-rw-r--r--src/Network/BitTorrent/DHT/Query.hs2
-rw-r--r--src/Network/BitTorrent/DHT/Session.hs5
-rw-r--r--tests/Network/BitTorrent/DHT/QuerySpec.hs4
-rw-r--r--tests/Network/BitTorrent/DHT/SessionSpec.hs6
6 files changed, 11 insertions, 10 deletions
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
114 let mkEx = Exchange.newManager (exchangeOptions pid opts) (connHandler tmap) 114 let mkEx = Exchange.newManager (exchangeOptions pid opts) (connHandler tmap)
115 (_, emgr) <- allocate mkEx Exchange.closeManager 115 (_, emgr) <- allocate mkEx Exchange.closeManager
116 116
117 let mkNode = DHT.newNode defaultHandlers def optNodeAddr logFun 117 let mkNode = DHT.newNode defaultHandlers def optNodeAddr logFun Nothing
118 (_, node) <- allocate mkNode DHT.closeNode 118 (_, node) <- allocate mkNode DHT.closeNode
119 119
120 resourceMap <- getInternalState 120 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
86 -> IO a -- ^ result. 86 -> IO a -- ^ result.
87dht opts addr action = do 87dht opts addr action = do
88 runStderrLoggingT $ LoggingT $ \ logger -> do 88 runStderrLoggingT $ LoggingT $ \ logger -> do
89 bracket (newNode defaultHandlers opts addr logger) closeNode $ 89 bracket (newNode defaultHandlers opts addr logger Nothing) closeNode $
90 \ node -> runDHT node action 90 \ node -> runDHT node action
91{-# INLINE dht #-} 91{-# INLINE dht #-}
92 92
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
160 $(logWarnS) "search" "start query" 160 $(logWarnS) "search" "start query"
161 responses <- lift $ queryParallel (action <$> batch) 161 responses <- lift $ queryParallel (action <$> batch)
162 let (nodes, results) = partitionEithers responses 162 let (nodes, results) = partitionEithers responses
163 $(logWarnS) "search" "done query" 163 $(logWarnS) "search" ("done query more:" <> T.pack (show $ L.length nodes))
164 leftover $ L.concat nodes 164 leftover $ L.concat nodes
165 mapM_ yield results 165 mapM_ yield results
166 166
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
299 -> Options -- ^ various dht options; 299 -> Options -- ^ various dht options;
300 -> NodeAddr ip -- ^ node address to bind; 300 -> NodeAddr ip -- ^ node address to bind;
301 -> LogFun -- ^ 301 -> LogFun -- ^
302 -> Maybe NodeId -- ^ use this NodeId, if not given a new one is generated.
302 -> IO (Node ip) -- ^ a new DHT node running at given address. 303 -> IO (Node ip) -- ^ a new DHT node running at given address.
303newNode hs opts naddr logger = do 304newNode hs opts naddr logger mbid = do
304 s <- createInternalState 305 s <- createInternalState
305 runInternalState initNode s 306 runInternalState initNode s
306 `onException` closeInternalState s 307 `onException` closeInternalState s
@@ -311,7 +312,7 @@ newNode hs opts naddr logger = do
311 s <- getInternalState 312 s <- getInternalState
312 (_, m) <- allocate (newManager rpcOpts nodeAddr hs) closeManager 313 (_, m) <- allocate (newManager rpcOpts nodeAddr hs) closeManager
313 liftIO $ do 314 liftIO $ do
314 myId <- genNodeId 315 myId <- maybe genNodeId return mbid
315 node <- Node opts myId s m 316 node <- Node opts myId s m
316 <$> newMVar (nullTable myId (optBucketCount opts)) 317 <$> newMVar (nullTable myId (optBucketCount opts))
317 <*> newTVarIO def 318 <*> newTVarIO def
diff --git a/tests/Network/BitTorrent/DHT/QuerySpec.hs b/tests/Network/BitTorrent/DHT/QuerySpec.hs
index 81c3b45b..6b3b5485 100644
--- a/tests/Network/BitTorrent/DHT/QuerySpec.hs
+++ b/tests/Network/BitTorrent/DHT/QuerySpec.hs
@@ -28,7 +28,7 @@ nullLogger _ _ _ _ = return ()
28 28
29simpleDHT :: [NodeHandler IPv4] -> DHT IPv4 a -> IO a 29simpleDHT :: [NodeHandler IPv4] -> DHT IPv4 a -> IO a
30simpleDHT hs m = 30simpleDHT hs m =
31 bracket (newNode hs def myAddr nullLogger) closeNode $ \ node -> 31 bracket (newNode hs def myAddr nullLogger Nothing) closeNode $ \ node ->
32 runDHT node m 32 runDHT node m
33 33
34getBootInfo :: IO (NodeInfo IPv4) 34getBootInfo :: IO (NodeInfo IPv4)
@@ -102,4 +102,4 @@ spec = parallel $ do
102 sourceList [startNodes] $= 102 sourceList [startNodes] $=
103 search entryHash (getPeersQ entryHash) $= 103 search entryHash (getPeersQ entryHash) $=
104 CL.concat $$ CL.take 10 104 CL.concat $$ CL.take 10
105 L.length peers `shouldBe` 10 \ No newline at end of file 105 L.length peers `shouldBe` 10
diff --git a/tests/Network/BitTorrent/DHT/SessionSpec.hs b/tests/Network/BitTorrent/DHT/SessionSpec.hs
index 8c536352..ef844b31 100644
--- a/tests/Network/BitTorrent/DHT/SessionSpec.hs
+++ b/tests/Network/BitTorrent/DHT/SessionSpec.hs
@@ -26,7 +26,7 @@ myAddr = "127.0.0.1:60000"
26 26
27simpleDHT :: DHT IPv4 a -> IO a 27simpleDHT :: DHT IPv4 a -> IO a
28simpleDHT m = 28simpleDHT m =
29 bracket (newNode defaultHandlers def myAddr nullLogger) closeNode $ \ node -> 29 bracket (newNode defaultHandlers def myAddr nullLogger Nothing) closeNode $ \ node ->
30 runDHT node m 30 runDHT node m
31 31
32isRight :: Either a b -> Bool 32isRight :: Either a b -> Bool
@@ -43,7 +43,7 @@ spec :: Spec
43spec = do 43spec = do
44 describe "session" $ do 44 describe "session" $ do
45 it "is active until closeNode called" $ do 45 it "is active until closeNode called" $ do
46 node <- newNode [] def myAddr nullLogger 46 node <- newNode [] def myAddr nullLogger Nothing
47 runDHT node monadActive `shouldReturn` True 47 runDHT node monadActive `shouldReturn` True
48 runDHT node monadActive `shouldReturn` True 48 runDHT node monadActive `shouldReturn` True
49 closeNode node 49 closeNode node
@@ -106,4 +106,4 @@ spec = do
106 106
107 describe "(<@>) operator" $ do 107 describe "(<@>) operator" $ do
108 it "" $ 108 it "" $
109 pending \ No newline at end of file 109 pending