diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | tests/Main.hs | 2 | ||||
-rw-r--r-- | tests/Network/BitTorrent/DHT/MessageSpec.hs | 17 |
3 files changed, 19 insertions, 1 deletions
@@ -11,3 +11,4 @@ upload-docs | |||
11 | 11 | ||
12 | *.ps | 12 | *.ps |
13 | *.prof | 13 | *.prof |
14 | res/rtorrent-sessiondir | ||
diff --git a/tests/Main.hs b/tests/Main.hs index 32ee3992..63281cf3 100644 --- a/tests/Main.hs +++ b/tests/Main.hs | |||
@@ -12,7 +12,7 @@ import Data.Functor | |||
12 | 12 | ||
13 | clients :: [(String, String)] | 13 | clients :: [(String, String)] |
14 | clients = [ | 14 | clients = [ |
15 | ("rtorrent","rtorrent -p 51234-51234 testfile.torrent") ] | 15 | ("rtorrent","rtorrent -p 51234-51234 -O dht=on -O dht_port=6881 -O session=rtorrent-sessiondir testfile.torrent") ] |
16 | 16 | ||
17 | main :: IO () | 17 | main :: IO () |
18 | main = do | 18 | main = do |
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs index ce2ac0de..af694470 100644 --- a/tests/Network/BitTorrent/DHT/MessageSpec.hs +++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs | |||
@@ -1,6 +1,7 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.DHT.MessageSpec (spec) where | 2 | module Network.BitTorrent.DHT.MessageSpec (spec) where |
3 | import Control.Monad.Reader | 3 | import Control.Monad.Reader |
4 | import Control.Concurrent | ||
4 | import Data.BEncode as BE | 5 | import Data.BEncode as BE |
5 | import Data.ByteString.Lazy as BL | 6 | import Data.ByteString.Lazy as BL |
6 | import Data.Default | 7 | import Data.Default |
@@ -11,6 +12,7 @@ import Network.KRPC | |||
11 | import Network.Socket (PortNumber) | 12 | import Network.Socket (PortNumber) |
12 | import Test.Hspec | 13 | import Test.Hspec |
13 | import Test.QuickCheck | 14 | import Test.QuickCheck |
15 | import System.Timeout | ||
14 | 16 | ||
15 | import Network.BitTorrent.CoreSpec () | 17 | import Network.BitTorrent.CoreSpec () |
16 | import Network.BitTorrent.DHT.TokenSpec () | 18 | import Network.BitTorrent.DHT.TokenSpec () |
@@ -37,9 +39,24 @@ isProtocolError KError {..} = errorCode == ProtocolError | |||
37 | prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation | 39 | prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation |
38 | prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x | 40 | prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x |
39 | 41 | ||
42 | retry :: Int -> IO (Maybe a) -> IO (Maybe a) | ||
43 | retry 0 _ = return Nothing | ||
44 | retry n a = do | ||
45 | res <- a | ||
46 | case res of | ||
47 | Just _ -> return res | ||
48 | Nothing -> threadDelay (100 * 1000) >> retry (n-1) a | ||
49 | |||
40 | spec :: Spec | 50 | spec :: Spec |
41 | spec = do | 51 | spec = do |
42 | context ("you need running DHT node at " ++ show remoteAddr) $ do | 52 | context ("you need running DHT node at " ++ show remoteAddr) $ do |
53 | it "is running" $ do | ||
54 | _ <- retry 5 $ timeout (100 * 1000) $ do | ||
55 | nid <- genNodeId | ||
56 | Response _remoteAddr Ping <- | ||
57 | rpc (query remoteAddr (Query nid Ping)) | ||
58 | return () | ||
59 | return () | ||
43 | describe "ping" $ do | 60 | describe "ping" $ do |
44 | it "properly bencoded" $ do | 61 | it "properly bencoded" $ do |
45 | BE.decode "d2:id20:abcdefghij0123456789e" | 62 | BE.decode "d2:id20:abcdefghij0123456789e" |