summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/DHT/SessionSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network/BitTorrent/DHT/SessionSpec.hs')
-rw-r--r--tests/Network/BitTorrent/DHT/SessionSpec.hs74
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 #-}
2module Network.BitTorrent.DHT.SessionSpec (spec) where
3import Control.Monad.Reader
4import Data.Default
5import Test.Hspec
6import Test.QuickCheck
7
8import Network.BitTorrent.Core
9import Network.BitTorrent.DHT
10import Network.BitTorrent.DHT.Message
11import Network.BitTorrent.DHT.Session
12
13import Data.Torrent.InfoHashSpec ()
14import Network.BitTorrent.CoreSpec ()
15import Network.BitTorrent.DHT.TokenSpec ()
16
17
18myAddr :: NodeAddr IPv4
19myAddr = "127.0.0.1:60000"
20
21simpleDHT :: DHT IPv4 a -> IO a
22simpleDHT = dht def myAddr
23
24isRight :: Either a b -> Bool
25isRight (Left _) = False
26isRight (Right _) = True
27
28isLeft :: Either a b -> Bool
29isLeft = not . isRight
30
31spec :: Spec
32spec = 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