diff options
Diffstat (limited to 'tests/Network/BitTorrent/DHT')
-rw-r--r-- | tests/Network/BitTorrent/DHT/TokenSpec.hs | 32 |
1 files changed, 30 insertions, 2 deletions
diff --git a/tests/Network/BitTorrent/DHT/TokenSpec.hs b/tests/Network/BitTorrent/DHT/TokenSpec.hs index 90ff0f03..6353a24c 100644 --- a/tests/Network/BitTorrent/DHT/TokenSpec.hs +++ b/tests/Network/BitTorrent/DHT/TokenSpec.hs | |||
@@ -1,14 +1,42 @@ | |||
1 | {-# LANGUAGE ScopedTypeVariables #-} | ||
1 | {-# OPTIONS_GHC -fno-warn-orphans #-} | 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} |
2 | module Network.BitTorrent.DHT.TokenSpec (spec) where | 3 | module Network.BitTorrent.DHT.TokenSpec (spec) where |
3 | import Control.Applicative | 4 | import Control.Applicative |
5 | import Data.List as L | ||
4 | import Data.String | 6 | import Data.String |
5 | import Test.Hspec | 7 | import Test.Hspec |
6 | import Test.QuickCheck | 8 | import Test.QuickCheck |
7 | import Network.BitTorrent.DHT.Token | 9 | |
10 | import Network.BitTorrent.Core | ||
11 | import Network.BitTorrent.CoreSpec () | ||
12 | import Network.BitTorrent.DHT.Token as T | ||
8 | 13 | ||
9 | 14 | ||
10 | instance Arbitrary Token where | 15 | instance Arbitrary Token where |
11 | arbitrary = fromString <$> arbitrary | 16 | arbitrary = fromString <$> arbitrary |
12 | 17 | ||
18 | instance Arbitrary TokenMap where | ||
19 | arbitrary = tokens <$> arbitrary | ||
20 | |||
21 | repeatN :: Int -> (a -> a) -> (a -> a) | ||
22 | repeatN n f = L.foldr (.) id $ L.replicate n f | ||
23 | |||
13 | spec :: Spec | 24 | spec :: Spec |
14 | spec = return () \ No newline at end of file | 25 | spec = do |
26 | describe "Token" $ do | ||
27 | return () | ||
28 | |||
29 | describe "TokenMap" $ do | ||
30 | it "is keeping any granted token in current session" $ | ||
31 | property $ \ (addr :: NodeAddr IPv4) m -> | ||
32 | T.member addr (T.lookup addr m) m | ||
33 | |||
34 | it "is keeping any granted token in next session" $ | ||
35 | property $ \ (addr :: NodeAddr IPv4) m -> | ||
36 | T.member addr (T.lookup addr m) (T.update m) | ||
37 | |||
38 | -- can fail with some small probability | ||
39 | it "is rejecting any outdated tokens" $ | ||
40 | property $ \ (addr :: NodeAddr IPv4) m k -> not $ | ||
41 | let n = min 100 (abs k + 2) in | ||
42 | T.member addr (T.lookup addr m) (repeatN n T.update m) \ No newline at end of file | ||