blob: 75c9546285853a588da7ca8e818437738d48cfa6 (
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
|
{-# LANGUAGE ScopedTypeVariables #-}
module Network.BitTorrent.DHT.SessionSpec (spec) where
import Control.Monad.Reader
import Data.Default
import Test.Hspec
import Test.QuickCheck
import Network.BitTorrent.Core
import Network.BitTorrent.DHT
import Network.BitTorrent.DHT.Message
import Network.BitTorrent.DHT.Session
import Data.Torrent.InfoHashSpec ()
import Network.BitTorrent.CoreSpec ()
import Network.BitTorrent.DHT.TokenSpec ()
myAddr :: NodeAddr IPv4
myAddr = "127.0.0.1:60000"
simpleDHT :: DHT IPv4 a -> IO a
simpleDHT = dht def myAddr
isRight :: Either a b -> Bool
isRight (Left _) = False
isRight (Right _) = True
isLeft :: Either a b -> Bool
isLeft = not . isRight
spec :: Spec
spec = do
describe "tokens" $ do
it "should not complain about valid token" $
property $ \ (addrs :: [NodeAddr IPv4]) -> do
simpleDHT $ do
forM_ addrs $ \ addr -> do
token <- grantToken addr
checkToken addr token
{-
it "" $ property $ \ (addr :: NodeAddr IPv4) token -> do
simpleDHT (checkToken addr token) `shouldThrow` (== undefined)
-}
describe "routing table" $ do
return ()
describe "peer storage" $ do
it "should return nodes, if there are no peers" $ property $ \ ih -> do
nodes <- simpleDHT $ do getPeerList ih
nodes `shouldSatisfy` isLeft
it "should return peers, if any" $ property $ \ ih addr -> do
peers <- simpleDHT $ do
insertPeer ih addr
getPeerList ih
peers `shouldSatisfy` isRight
describe "topic storage" $ do
return ()
describe "messaging" $ do
describe "queryNode" $ do
it "should always ping this node" $ do
(rid, tid) <- simpleDHT $ do
(remoteId, Ping) <- queryNode myAddr Ping
thisId <- asks thisNodeId
return (remoteId, thisId)
rid `shouldBe` tid
describe "queryParallel" $ do
return ()
describe "(<@>) operator" $ do
return ()
|
