blob: 3077a52a11d8350e7d54d9a896e0eabc310bf9c6 (
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
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.BitTorrent.DHT.RoutingSpec (spec) where
import Control.Applicative
import Control.Monad.State
import Data.Default
import Data.List as L
import Data.Maybe
import Test.Hspec
import Test.QuickCheck
import Network.BitTorrent.Address
import Network.BitTorrent.DHT.Routing as T
import Network.BitTorrent.CoreSpec hiding (spec)
type Network ip = [NodeAddr ip]
data Env ip = Env
{ currentTime :: Timestamp
, network :: Network ip
} deriving Show
type Simulation ip = State (Env ip)
runSimulation :: Eq ip => Env ip -> Routing ip a -> Maybe a
runSimulation e m = evalState (runRouting ping closest timestamp m) e
where
ping addr = gets (L.elem addr . network)
closest nid = error "runSimulation"
timestamp = gets currentTime
instance Arbitrary ip => Arbitrary (Env ip) where
arbitrary = Env <$> arbitrary <*> (vector nodeCount)
where
nodeCount = 1000
instance (Arbitrary ip, Eq ip) => Arbitrary (Table ip) where
arbitrary = do
thisId <- arbitrary
bucketN <- choose (1, 20)
let table = nullTable thisId bucketN
-- nodeN <- (`mod` bucketN) <$> arbitrary
-- nodes <- vector nodeN
node <- arbitrary
mt <- runSimulation <$> arbitrary
<*> pure (T.insert node table)
--(foldM (flip fillTable) table nodes)
return (fromJust mt)
where
fillTable x t = do
t' <- T.insert x t
return $ if T.full t' then t else t'
spec :: Spec
spec = do
describe "size" $ do
it "null table is empty" $ do
T.size (nullTable def 2 :: Table IPv4) `shouldBe` 0
it "the same node never appear in different buckets" $ property $ \ t -> do
let xss = T.toList (t :: Table Int)
let justOnce x = L.length (L.filter (L.elem x) xss) == 1
L.all justOnce (L.concat xss)
it "insert is idemponent" $ do
pending
{-
property $ \ (e :: Env Int) n t -> do
let t1 = runSimulation e (T.insert n t)
let t2 = runSimulation e (T.insert n t >>= T.insert n)
t1 `shouldBe` t2
-}
|
