blob: d25bd120e7734eae5b104f8f0e9debc94a8db7b7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent.DHT.QuerySpec (spec) where
import Control.Applicative
import Control.Exception
import Control.Monad.Reader
import Data.Conduit as C
import Data.Conduit.List as CL
import Data.Default
import Data.List as L
import Test.Hspec
import Network.BitTorrent.Core
import Network.BitTorrent.DHT
import Network.BitTorrent.DHT.Session
import Network.BitTorrent.DHT.Query
import Network.BitTorrent.DHT.TestData
myAddr :: NodeAddr IPv4
myAddr = "0.0.0.0:0"
nullLogger :: LogFun
nullLogger _ _ _ _ = return ()
--simpleLogger :: LogFun
--simpleLogger _ t _ _ = print t
simpleDHT :: [NodeHandler IPv4] -> DHT IPv4 a -> IO a
simpleDHT hs m =
bracket (newNode hs def myAddr nullLogger) closeNode $ \ node ->
runDHT node m
getBootInfo :: IO (NodeInfo IPv4)
getBootInfo = do
startAddr <- resolveHostName (L.head defaultBootstrapNodes)
simpleDHT [] $ pingQ startAddr
spec :: Spec
spec = parallel $ do
describe "environment" $ do
describe "test node" $ do
it "is alive" $ do
_ <- getBootInfo
return ()
describe "handlers" $ do
it "" $ pendingWith "need to setup 2 DHT locally"
describe "basic queries" $ do
it "ping" $ do
_ <- getBootInfo
return ()
it "findNode" $ do
startInfo <- getBootInfo
_ <- simpleDHT [] $ do
nid <- asks thisNodeId
findNodeQ nid startInfo
return ()
it "getPeers" $ do
startInfo <- getBootInfo
peers <- simpleDHT [] $ do
nid <- asks thisNodeId
-- we should not run getPeers query on boot node, because
-- it may not support it
Right infos <- findNodeQ nid startInfo
when (L.null infos) $
error "boot node malfunction"
-- at least one node should reply
queryParallel $ do
getPeersQ (entryHash (L.head testTorrents)) <$> infos
peers `shouldSatisfy` (not . L.null)
it "announce" $ do
bootNode <- getBootInfo
_ <- simpleDHT [] $ do
let ih = entryHash (L.head testTorrents)
Right nodes <- findNodeQ ih bootNode
when (L.null nodes) $
error "boot node malfunction"
queryParallel $ do
announceQ ih (nodePort myAddr) <$> nodes
return ()
describe "iterative queries" $ do
forM_ testTorrents $ \ TestEntry {..} -> do
context entryName $ do
it "get at least 10 unique peers for each infohash" $ do
bootNode <- getBootInfo
peers <- simpleDHT [] $ do
Right startNodes <- findNodeQ entryHash bootNode
sourceList [startNodes] $=
search entryHash (getPeersQ entryHash) $=
CL.concat $$ CL.take 10
L.length peers `shouldBe` 10
|
