1 files changed, 77 insertions, 0 deletions

diff --git a/bittorrent/tests/Network/BitTorrent/DHT/RoutingSpec.hs b/bittorrent/tests/Network/BitTorrent/DHT/RoutingSpec.hs
new file mode 100644
index 00000000..07a906ba
--- /dev/null
+++ b/bittorrent/tests/Network/BitTorrent/DHT/RoutingSpec.hs
@@ -0,0 +1,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 <- do
+        env <- arbitrary
+        return $ runSimulation env $ do
+            (_,t') <- T.insert (currentTime env) (TryInsert node) table
+            return t' :: Routing ip (Table ip)
+          --(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" $ property $ \ (e :: Env Int) n t -> do
+      let ins :: NodeInfo Int -> Table Int -> Routing Int (Table Int)
+          ins n t = snd <$> T.insert (currentTime e) (TryInsert n) t
+      let t1 = runSimulation e (ins n t)
+      let t2 = runSimulation e (ins n t >>= ins n)
+      t1 `shouldBe` t2