diff options
Diffstat (limited to 'tests/Network/BitTorrent/DHT/SessionSpec.hs')
-rw-r--r-- | tests/Network/BitTorrent/DHT/SessionSpec.hs | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/tests/Network/BitTorrent/DHT/SessionSpec.hs b/tests/Network/BitTorrent/DHT/SessionSpec.hs new file mode 100644 index 00000000..75c95462 --- /dev/null +++ b/tests/Network/BitTorrent/DHT/SessionSpec.hs | |||
@@ -0,0 +1,74 @@ | |||
1 | {-# LANGUAGE ScopedTypeVariables #-} | ||
2 | module Network.BitTorrent.DHT.SessionSpec (spec) where | ||
3 | import Control.Monad.Reader | ||
4 | import Data.Default | ||
5 | import Test.Hspec | ||
6 | import Test.QuickCheck | ||
7 | |||
8 | import Network.BitTorrent.Core | ||
9 | import Network.BitTorrent.DHT | ||
10 | import Network.BitTorrent.DHT.Message | ||
11 | import Network.BitTorrent.DHT.Session | ||
12 | |||
13 | import Data.Torrent.InfoHashSpec () | ||
14 | import Network.BitTorrent.CoreSpec () | ||
15 | import Network.BitTorrent.DHT.TokenSpec () | ||
16 | |||
17 | |||
18 | myAddr :: NodeAddr IPv4 | ||
19 | myAddr = "127.0.0.1:60000" | ||
20 | |||
21 | simpleDHT :: DHT IPv4 a -> IO a | ||
22 | simpleDHT = dht def myAddr | ||
23 | |||
24 | isRight :: Either a b -> Bool | ||
25 | isRight (Left _) = False | ||
26 | isRight (Right _) = True | ||
27 | |||
28 | isLeft :: Either a b -> Bool | ||
29 | isLeft = not . isRight | ||
30 | |||
31 | spec :: Spec | ||
32 | spec = do | ||
33 | describe "tokens" $ do | ||
34 | it "should not complain about valid token" $ | ||
35 | property $ \ (addrs :: [NodeAddr IPv4]) -> do | ||
36 | simpleDHT $ do | ||
37 | forM_ addrs $ \ addr -> do | ||
38 | token <- grantToken addr | ||
39 | checkToken addr token | ||
40 | {- | ||
41 | it "" $ property $ \ (addr :: NodeAddr IPv4) token -> do | ||
42 | simpleDHT (checkToken addr token) `shouldThrow` (== undefined) | ||
43 | -} | ||
44 | describe "routing table" $ do | ||
45 | return () | ||
46 | |||
47 | describe "peer storage" $ do | ||
48 | it "should return nodes, if there are no peers" $ property $ \ ih -> do | ||
49 | nodes <- simpleDHT $ do getPeerList ih | ||
50 | nodes `shouldSatisfy` isLeft | ||
51 | |||
52 | it "should return peers, if any" $ property $ \ ih addr -> do | ||
53 | peers <- simpleDHT $ do | ||
54 | insertPeer ih addr | ||
55 | getPeerList ih | ||
56 | peers `shouldSatisfy` isRight | ||
57 | |||
58 | describe "topic storage" $ do | ||
59 | return () | ||
60 | |||
61 | describe "messaging" $ do | ||
62 | describe "queryNode" $ do | ||
63 | it "should always ping this node" $ do | ||
64 | (rid, tid) <- simpleDHT $ do | ||
65 | (remoteId, Ping) <- queryNode myAddr Ping | ||
66 | thisId <- asks thisNodeId | ||
67 | return (remoteId, thisId) | ||
68 | rid `shouldBe` tid | ||
69 | |||
70 | describe "queryParallel" $ do | ||
71 | return () | ||
72 | |||
73 | describe "(<@>) operator" $ do | ||
74 | return () \ No newline at end of file | ||