Factor out some new libraries

	word64-map:
		Data.Word64Map
	network-addr:
		Network.Address
	tox-crypto:
		Crypto.Tox
	lifted-concurrent:
		Control.Concurrent.Lifted.Instrument
		Control.Concurrent.Async.Lifted.Instrument
	psq-wrap:
		Data.Wrapper.PSQInt
		Data.Wrapper.PSQ
	minmax-psq:
		Data.MinMaxPSQ
        tasks:
                Control.Concurrent.Tasks
	kad:
		Network.Kademlia
		Network.Kademlia.Bootstrap
		Network.Kademlia.Routing
		Network.Kademlia.CommonAPI
		Network.Kademlia.Persistence
		Network.Kademlia.Search

7 files changed, 685 insertions, 0 deletions

diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/ListSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/ListSpec.hs
new file mode 100644
index 00000000..bba9d0e2
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/ListSpec.hs
@@ -0,0 +1,40 @@
+module Network.BitTorrent.Tracker.ListSpec (spec) where
+import Control.Exception
+import Data.Default
+import Data.Foldable as F
+import Data.List as L
+import Data.Maybe
+import Network.URI
+import Test.Hspec
+
+import Data.Torrent
+import Network.BitTorrent.Tracker.List
+import Network.BitTorrent.Tracker.RPC
+
+
+uris :: [URI]
+uris = fmap (fromJust . parseURI . renderURI) [1..10 :: Int]
+  where
+    renderURI n = "http://" ++ show n ++ ".org"
+
+list :: TrackerList ()
+list = trackerList def { tAnnounceList = Just [uris] }
+
+spec :: Spec
+spec = do
+  describe "TrackerList" $ do
+    it "shuffleTiers (may fail with very small probability)" $ do
+      list' <- shuffleTiers list
+      list' `shouldSatisfy` (/= list)
+
+    it "traverseAll" $ do
+      xs <- traverseAll (\ (uri, _) -> if uri == L.last uris
+               then throwIO (GenericException "")
+               else return ()) list
+      return ()
+
+    it "traverseTiers" $ do
+      xs' <- traverseTiers (\ (uri, _) -> if uri == L.last uris then return ()
+                              else throwIO (GenericException "")) list
+
+      return ()
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/MessageSpec.hs
new file mode 100644
index 00000000..29854d58
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/MessageSpec.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS -fno-warn-orphans  #-}
+module Network.BitTorrent.Tracker.MessageSpec
+       ( spec
+       , arbitrarySample
+       ) where
+
+import Control.Applicative
+import Control.Exception
+import Data.BEncode as BE
+import Data.ByteString.Lazy as BL
+import Data.List as L
+import Data.Maybe
+import Test.Hspec
+import Test.QuickCheck
+
+import Data.TorrentSpec ()
+import Network.BitTorrent.Internal.ProgressSpec ()
+import Network.BitTorrent.Address ()
+import Network.BitTorrent.Address ()
+
+import Network.BitTorrent.Tracker.Message as Message
+import Network.BitTorrent.Address
+
+
+--prop_bencode :: Eq a => BEncode a => a -> Bool
+--prop_bencode a = BE.decode (BL.toStrict (BE.encode a)) == return a
+
+--prop_urlencode :: Eq a => URLDecoded a => URLEncoded a => a -> Bool
+--prop_urlencode a = urlDecode (T.pack (urlEncode a)) == a
+
+instance Arbitrary AnnounceEvent where
+  arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary AnnounceQuery where
+  arbitrary = AnnounceQuery
+    <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+    <*> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary (PeerList IP) where
+  arbitrary = frequency
+    [ (1,        (PeerList . maybeToList) <$> arbitrary)
+    , (1, (CompactPeerList . maybeToList . fmap zeroPeerId) <$> arbitrary)
+    ]
+
+  shrink (       PeerList xs) =        PeerList <$> shrink xs
+  shrink (CompactPeerList xs) = CompactPeerList <$> shrink xs
+
+instance Arbitrary AnnounceInfo where
+  arbitrary = AnnounceInfo
+    <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+    <*> arbitrary <*> arbitrary
+
+arbitrarySample :: Arbitrary a => IO a
+arbitrarySample = L.head <$> sample' arbitrary
+
+zeroPeerId :: PeerAddr a -> PeerAddr a
+zeroPeerId addr = addr { peerId = Nothing }
+
+spec :: Spec
+spec = do
+  describe "AnnounceQuery" $ do
+    it "properly url encoded" $ property $ \ q ->
+      parseAnnounceQuery (renderAnnounceQuery q)
+        `shouldBe` Right q
+
+  describe "PeerList" $ do
+    context "Non compact" $ do
+      it "properly encoded (both ipv4 and ipv6)" $ do
+        BE.decode "ld2:ip7:1.2.3.44:porti80eed2:ip3:::14:porti8080eee"
+          `shouldBe` Right
+          (PeerList ["1.2.3.4:80", "[::1]:8080"] :: PeerList IPv4)
+
+      it "properly encoded (iso)" $ property $ \ xs ->
+        BE.decode (BL.toStrict (BE.encode (PeerList xs :: PeerList IPv4)))
+          `shouldBe` Right (PeerList xs :: PeerList IPv4)
+
+    context "Compact" $ do
+      it "properly encodes (ipv4)" $ do
+        BE.decode "12:\x1\x2\x3\x4\x1\x2\x9\x8\x7\x6\x1\x2"
+          `shouldBe` Right
+          (CompactPeerList ["1.2.3.4:258", "9.8.7.6:258"] :: PeerList IPv4)
+
+      it "properly encodes (ipv6)" $ do
+        BE.decode "18:\x1\x2\x3\x4\x5\x6\x7\x8\x1\x2\x3\x4\x5\x6\x7\x8\x1\x2"
+          `shouldBe` Right
+          (CompactPeerList ["[102:304:506:708:102:304:506:708]:258"]
+           :: PeerList IPv6)
+
+      it "properly encoded (ipv4, iso)" $
+        property $ \ (fmap zeroPeerId -> xs) ->
+          BE.decode (BL.toStrict (BE.encode (CompactPeerList xs)))
+            `shouldBe` Right (CompactPeerList xs :: PeerList IPv4)
+
+      it "properly encoded (ipv6, iso)" $
+        property $ \ (fmap zeroPeerId -> xs) ->
+          BE.decode (BL.toStrict (BE.encode (CompactPeerList xs)))
+            `shouldBe` Right (CompactPeerList xs :: PeerList IPv6)
+
+  describe "AnnounceInfo" $ do
+    it "parses minimal sample" $ do
+      "d8:intervali0e5:peerslee"
+        `shouldBe`
+        AnnounceInfo Nothing Nothing 0 Nothing (PeerList []) Nothing
+
+    it "parses optional fields" $ do
+      "d8:completei1e\
+       \10:incompletei2e\
+       \8:intervali3e\
+       \12:min intervali4e\
+       \5:peersle\
+       \15:warning message3:str\
+       \e"
+        `shouldBe`
+        AnnounceInfo (Just 1) (Just 2) 3 (Just 4) (PeerList []) (Just "str")
+
+    it "parses failed response" $ do
+      "d14:failure reason10:any reasone"
+                 `shouldBe`
+        Message.Failure "any reason"
+
+    it "fail if no peer list present" $ do
+      evaluate ("d8:intervali0ee" :: AnnounceInfo)
+        `shouldThrow`
+         errorCall "fromString: unable to decode AnnounceInfo: \
+                   \required field `peers' not found"
+
+    it "parses `peer' list" $ do -- TODO
+      "d8:intervali0e\
+       \5:peersl\
+               \d2:ip7:1.2.3.4\
+                \4:porti80e\
+               \e\
+               \d2:ip3:::1\
+                \4:porti80e\
+               \e\
+              \e\
+       \e" `shouldBe`
+        let xs = PeerList ["1.2.3.4:80", "[::1]:80"] in
+        AnnounceInfo Nothing Nothing 0 Nothing xs Nothing
+
+    it "parses `peers6' list" $ do
+      "d8:intervali0e\
+       \5:peers0:\
+       \6:peers60:\
+      \e" `shouldBe`
+        AnnounceInfo Nothing Nothing 0 Nothing (CompactPeerList []) Nothing
+
+    it "fails on invalid combinations of the peer lists" $ do
+      BE.decode "d8:intervali0e\
+                 \5:peers0:\
+                 \6:peers6le\
+                \e"
+        `shouldBe` (Left
+        "PeerList: the `peers6' field value should contain \
+                  \*compact* peer list" :: BE.Result AnnounceInfo)
+
+      BE.decode "d8:intervali0e\
+                 \5:peersle\
+                 \6:peers60:\
+                \e"
+        `shouldBe` (Left
+        "PeerList: non-compact peer list provided, \
+                  \but the `peers6' field present" :: BE.Result AnnounceInfo)
+
+    it "properly bencoded (iso)" $ property $ \ info ->
+      BE.decode (BL.toStrict (BE.encode info))
+        `shouldBe` Right (info :: AnnounceInfo)
+
+  describe "Scrape" $ do
+    return ()
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
new file mode 100644
index 00000000..e928f917
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec) where
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Test.Hspec
+
+import Network.BitTorrent.Internal.Progress
+import Network.BitTorrent.Tracker.Message as Message
+import Network.BitTorrent.Tracker.RPC.HTTP
+
+import Network.BitTorrent.Tracker.TestData
+import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+
+
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo _ (Message.Failure reason) = do
+  error $ "validateInfo: " ++ show reason
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+  return ()
+--  case respComplete <|> respIncomplete of
+--    Nothing -> return ()
+--    Just n  -> n  `shouldBe` L.length (getPeerList respPeers)
+
+isUnrecognizedScheme :: RpcException -> Bool
+isUnrecognizedScheme (RequestFailed _) = True
+isUnrecognizedScheme  _                = False
+
+isNotResponding :: RpcException -> Bool
+isNotResponding (RequestFailed _) = True
+isNotResponding  _                = False
+
+spec :: Spec
+spec = parallel $ do
+  describe "Manager" $ do
+    describe "newManager" $ do
+      it "" $ pending
+
+    describe "closeManager" $ do
+      it "" $ pending
+
+    describe "withManager" $ do
+      it "" $ pending
+
+  describe "RPC" $ do
+    describe "announce" $ do
+      it "must fail on bad uri scheme" $ do
+        withManager def $ \ mgr -> do
+          q    <- arbitrarySample
+          announce mgr "magnet://foo.bar" q
+            `shouldThrow` isUnrecognizedScheme
+
+    describe "scrape" $ do
+      it "must fail on bad uri scheme" $ do
+        withManager def $ \ mgr -> do
+          scrape mgr "magnet://foo.bar" []
+            `shouldThrow` isUnrecognizedScheme
+
+    forM_ (L.filter isHttpTracker trackers) $ \ TrackerEntry {..} ->
+      context trackerName $ do
+
+        describe "announce" $ do
+          if tryAnnounce
+            then do
+              it "have valid response" $ do
+                withManager def $ \ mgr -> do
+--                  q    <- arbitrarySample
+                  let ih = maybe def L.head hashList
+                  let q = AnnounceQuery ih "-HS0003-203534.37420" 6000
+                          (Progress 0 0 0) Nothing Nothing (Just Started)
+                  info <- announce mgr trackerURI q
+                  validateInfo q info
+            else do
+              it "should fail with RequestFailed" $ do
+                withManager def $ \ mgr -> do
+                  q <- arbitrarySample
+                  announce mgr trackerURI q
+                    `shouldThrow` isNotResponding
+
+        describe "scrape" $ do
+          if tryScraping
+            then do
+              it "have valid response" $ do
+                withManager def $ \ mgr -> do
+                  xs <- scrape mgr trackerURI [def]
+                  L.length xs `shouldSatisfy` (>= 1)
+            else do
+              it "should fail with ScrapelessTracker" $ do
+                pending
+
+          when (not tryAnnounce) $ do
+            it "should fail with RequestFailed" $ do
+              withManager def $ \ mgr -> do
+                scrape mgr trackerURI [def]
+                  `shouldThrow` isNotResponding
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
new file mode 100644
index 00000000..73acb3fa
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, rpcOpts) where
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Exception
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Data.Maybe
+import Test.Hspec
+
+import Network.BitTorrent.Address
+import Network.BitTorrent.Tracker.Message as Message
+
+import Network.BitTorrent.Tracker.TestData
+import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import Network.BitTorrent.Tracker.RPC.UDP
+
+
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo _ Message.Failure {} = error "validateInfo: failure"
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+    respComplete    `shouldSatisfy` isJust
+    respIncomplete  `shouldSatisfy` isJust
+    respMinInterval `shouldSatisfy` isNothing
+    respWarning     `shouldSatisfy` isNothing
+    peerList `shouldSatisfy` L.all (isNothing . peerId)
+  where
+    peerList = getPeerList respPeers
+
+-- | Number of concurrent calls.
+rpcCount :: Int
+rpcCount = 100
+
+rpcOpts :: Options
+rpcOpts = def
+  { optMinTimeout = 1
+  , optMaxTimeout = 10
+  }
+
+isTimeoutExpired :: RpcException -> Bool
+isTimeoutExpired (TimeoutExpired _) = True
+isTimeoutExpired  _                 = False
+
+isSomeException :: SomeException -> Bool
+isSomeException _ = True
+
+isIOException :: IOException -> Bool
+isIOException _ = True
+
+spec :: Spec
+spec = parallel $ do
+  describe "newManager" $ do
+    it "should throw exception on zero optMaxPacketSize" $ do
+      let opts = def { optMaxPacketSize = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMinTimout" $ do
+      let opts = def { optMinTimeout = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMaxTimeout" $ do
+      let opts = def { optMaxTimeout = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on maxTimeout < minTimeout" $ do
+      let opts = def { optMinTimeout = 2, optMaxTimeout = 1 }
+      newManager opts `shouldThrow` isSomeException
+
+    it "should throw exception on zero optMultiplier" $ do
+      let opts = def { optMultiplier = 0 }
+      newManager opts `shouldThrow` isSomeException
+
+  describe "closeManager" $ do
+    it "unblock rpc calls" $ do
+      mgr <- newManager rpcOpts
+      _   <- forkIO $ do
+        threadDelay 10000000
+        closeManager mgr
+      q <- arbitrarySample
+      announce mgr (trackerURI badTracker) q `shouldThrow` (== ManagerClosed)
+
+    it "announce throw exception after manager closed" $ do
+      mgr <- newManager rpcOpts
+      closeManager mgr
+      q <- arbitrarySample
+      announce mgr (trackerURI badTracker) q `shouldThrow` isIOException
+
+    it "scrape throw exception after manager closed" $ do
+      mgr <- newManager rpcOpts
+      closeManager mgr
+      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isIOException
+
+  describe "withManager" $ do
+    it "closesManager at exit" $ do
+      mgr <- withManager rpcOpts return
+      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isSomeException
+
+  describe "RPC" $ do
+    describe "announce" $ do
+      it "must fail on bad scheme" $ do
+        withManager rpcOpts $ \ mgr -> do
+          q <- arbitrarySample
+          announce mgr "magnet://a.com" q
+            `shouldThrow` (== UnrecognizedScheme "magnet:")
+
+    describe "scrape" $ do
+      it "must fail on bad scheme" $ do
+        withManager rpcOpts $ \ mgr -> do
+          scrape mgr "magnet://a.com" []
+            `shouldThrow` (== UnrecognizedScheme "magnet:")
+
+    forM_ (L.filter isUdpTracker trackers) $ \ TrackerEntry {..} ->
+      context trackerName $ do
+
+        describe "announce" $ do
+          if tryAnnounce then do
+            it "have valid response" $ do
+              withManager rpcOpts $ \ mgr -> do
+                q <- arbitrarySample
+                announce mgr trackerURI q >>= validateInfo q
+          else do
+            it "should throw TimeoutExpired" $ do
+              withManager rpcOpts $ \ mgr -> do
+                q <- arbitrarySample
+                announce mgr trackerURI q `shouldThrow` isTimeoutExpired
+
+        describe "scrape" $ do
+          if tryScraping then do
+            it "have valid response" $ do
+              withManager rpcOpts $ \ mgr -> do
+                xs <- scrape mgr trackerURI [def]
+                L.length xs `shouldSatisfy` (>= 1)
+          else do
+            it "should throw TimeoutExpired" $ do
+              withManager rpcOpts $ \ mgr -> do
+                scrape mgr trackerURI [def] `shouldThrow` isTimeoutExpired
+
+        describe "Manager" $ do
+          when tryScraping $ do
+            it "should handle arbitrary intermixed concurrent queries" $ do
+              withManager rpcOpts $ \ mgr -> do
+                _ <- mapConcurrently (\ _ -> scrape mgr trackerURI [def]) [1..rpcCount]
+                return ()
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs
new file mode 100644
index 00000000..dfc13a1e
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Network.BitTorrent.Tracker.RPCSpec (spec) where
+import Control.Applicative
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Test.Hspec
+import Test.QuickCheck
+
+import Network.BitTorrent.Tracker.RPC as RPC
+
+import           Network.BitTorrent.Tracker.TestData
+import           Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import qualified Network.BitTorrent.Tracker.RPC.UDPSpec as UDP (rpcOpts)
+
+
+instance Arbitrary SAnnounceQuery where
+  arbitrary = SAnnounceQuery <$> arbitrary <*> arbitrary
+                             <*> arbitrary <*> arbitrary
+
+rpcOpts :: Options
+rpcOpts = def
+  { optUdpRPC = UDP.rpcOpts
+  }
+
+matchUnrecognizedScheme :: String -> RpcException -> Bool
+matchUnrecognizedScheme x (UnrecognizedScheme scheme) = x == scheme
+matchUnrecognizedScheme _  _                          = False
+
+spec :: Spec
+spec = parallel $ do
+  describe "Manager" $ do
+    describe "newManager" $ do
+      it "" $ pending
+
+    describe "closeManager" $ do
+      it "" $ pending
+
+    describe "withManager" $ do
+      it "" $ pending
+
+  describe "RPC" $ do
+    describe "announce" $ do
+      it "must fail on bad uri scheme" $ do
+        withManager rpcOpts def $ \ mgr -> do
+          q    <- arbitrarySample
+          announce mgr "magnet://foo.bar" q
+            `shouldThrow` matchUnrecognizedScheme "magnet:"
+
+    describe "scrape" $ do
+      it "must fail on bad uri scheme" $ do
+        withManager rpcOpts def $ \ mgr -> do
+          scrape mgr "magnet://foo.bar" []
+            `shouldThrow` matchUnrecognizedScheme "magnet:"
+
+    forM_ trackers $ \ TrackerEntry {..} ->
+      context trackerName $ do
+
+        describe "announce" $ do
+          if tryAnnounce then do
+            it "have valid response" $ do
+              withManager rpcOpts def $ \ mgr -> do
+                q    <- arbitrarySample
+                _    <- announce mgr trackerURI q
+                return ()
+          else do
+            it "should throw exception" $ do
+              pending
+
+        describe "scrape" $ do
+          if tryScraping then do
+            it "have valid response" $ do
+              withManager rpcOpts def $ \ mgr -> do
+                xs <- scrape mgr trackerURI [def]
+                L.length xs `shouldSatisfy` (>= 1)
+          else do
+            it "should throw exception" $ do
+              pending
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/SessionSpec.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/SessionSpec.hs
new file mode 100644
index 00000000..72936ee7
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/SessionSpec.hs
@@ -0,0 +1,61 @@
+module Network.BitTorrent.Tracker.SessionSpec (spec) where
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Test.Hspec
+
+import Data.Torrent
+import Network.BitTorrent.Tracker.Message
+import Network.BitTorrent.Tracker.List
+import Network.BitTorrent.Tracker.RPC
+import Network.BitTorrent.Tracker.Session
+
+import Config
+
+testSession :: Bool -> (Manager -> Session -> IO ()) -> IO ()
+testSession runEmpty action = do
+  t <- getTestTorrent
+  withManager def def $ \ m -> do
+    withSession m (idInfoHash (tInfoDict t)) (trackerList t) $ \ s ->
+      action m s
+
+    when runEmpty $ do
+      withSession m (idInfoHash (tInfoDict t)) def $ \ s ->
+        action m s
+
+spec :: Spec
+spec = do
+  describe "Session" $ do
+    it "start new session in paused state" $ do
+      testSession True $ \ _ s -> do
+        status <- getStatus s
+        status `shouldBe` Paused
+
+  describe "Query" $ do
+    it "change status after notify" $ do
+      testSession True $ \ m s -> do
+        notify m s Started
+        status <- getStatus s
+        status `shouldBe` Running
+
+        notify m s Stopped
+        stopped <- getStatus s
+        stopped `shouldBe` Paused
+
+    it "completed event do not change status" $ do
+      testSession True $ \ m s -> do
+        notify m s Completed
+        status <- getStatus s
+        status `shouldBe` Paused
+
+      testSession True $ \ m s -> do
+        notify m s Started
+        notify m s Completed
+        status <- getStatus s
+        status `shouldBe` Running
+
+    it "return non-empty list of peers" $ do
+      testSession False $ \ m s -> do
+        notify m s Started
+        peers <- askPeers m s
+        peers `shouldSatisfy` (not . L.null)
diff --git a/dht/bittorrent/tests/Network/BitTorrent/Tracker/TestData.hs b/dht/bittorrent/tests/Network/BitTorrent/Tracker/TestData.hs
new file mode 100644
index 00000000..b95e2df4
--- /dev/null
+++ b/dht/bittorrent/tests/Network/BitTorrent/Tracker/TestData.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Network.BitTorrent.Tracker.TestData
+       ( TrackerEntry (..)
+       , isUdpTracker
+       , isHttpTracker
+       , trackers
+       , badTracker
+       ) where
+
+import Data.Maybe
+import Data.String
+import Network.URI
+
+import Data.Torrent
+
+
+data TrackerEntry = TrackerEntry
+  { -- | May be used to show tracker name in test suite report.
+    trackerName :: String
+
+    -- | Announce uri of the tracker.
+  , trackerURI  :: URI
+
+    -- | Some trackers abadoned, so don't even try to announce.
+  , tryAnnounce :: Bool
+
+    -- | Some trackers do not support scraping, so we should not even
+    -- try to scrape them.
+  , tryScraping :: Bool
+
+    -- | Some trackers allow
+  , hashList    :: Maybe [InfoHash]
+  }
+
+isUdpTracker :: TrackerEntry -> Bool
+isUdpTracker TrackerEntry {..} = uriScheme trackerURI == "udp:"
+
+isHttpTracker :: TrackerEntry -> Bool
+isHttpTracker TrackerEntry {..} = uriScheme trackerURI == "http:"
+                               || uriScheme trackerURI == "https:"
+
+instance IsString URI where
+  fromString str = fromMaybe err $ parseURI str
+    where
+      err = error $ "fromString: bad URI " ++ show str
+
+trackerEntry :: URI -> TrackerEntry
+trackerEntry uri = TrackerEntry
+  { trackerName = maybe "<unknown>" uriRegName (uriAuthority uri)
+  , trackerURI  = uri
+  , tryAnnounce = False
+  , tryScraping = False
+  , hashList    = Nothing
+  }
+
+announceOnly :: String -> URI -> TrackerEntry
+announceOnly name uri = (trackerEntry uri)
+  { trackerName = name
+  , tryAnnounce = True
+  }
+
+announceScrape :: String -> URI -> TrackerEntry
+announceScrape name uri = (announceOnly name uri)
+  { tryScraping = True
+  }
+
+notWorking :: String -> URI -> TrackerEntry
+notWorking name uri = (trackerEntry uri)
+  { trackerName = name
+  }
+
+trackers :: [TrackerEntry]
+trackers =
+  [ (announceOnly "LinuxTracker"
+    "http://linuxtracker.org:2710/00000000000000000000000000000000/announce")
+    { hashList = Just ["1c82a95b9e02bf3db4183da072ad3ef656aacf0e"] -- debian 7
+    }
+
+  , (announceScrape "Arch" "http://tracker.archlinux.org:6969/announce")
+    { hashList = Just ["bc9ae647a3e6c3636de58535dd3f6360ce9f4621"]
+    }
+
+  , notWorking     "rarbg" "udp://9.rarbg.com:2710/announce"
+
+  , announceScrape "OpenBitTorrent" "udp://tracker.openbittorrent.com:80/announce"
+  , announceScrape "PublicBT"       "udp://tracker.publicbt.com:80/announce"
+  , notWorking     "OpenBitTorrent" "http://tracker.openbittorrent.com:80/announce"
+  , notWorking     "PublicBT"       "http://tracker.publicbt.com:80/announce"
+  ]
+
+badTracker :: TrackerEntry
+badTracker = notWorking "rarbg" "udp://9.rarbg.com:2710/announce"
\ No newline at end of file