summaryrefslogtreecommitdiff
path: root/bittorrent/tests/Network/BitTorrent/Exchange
diff options
context:
space:
mode:
Diffstat (limited to 'bittorrent/tests/Network/BitTorrent/Exchange')
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs14
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/BlockSpec.hs35
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/ConnectionSpec.hs58
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/DownloadSpec.hs59
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/MessageSpec.hs102
-rw-r--r--bittorrent/tests/Network/BitTorrent/Exchange/SessionSpec.hs64
6 files changed, 0 insertions, 332 deletions
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs
deleted file mode 100644
index 1ba772f6..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs
+++ /dev/null
@@ -1,14 +0,0 @@
1{-# OPTIONS -fno-warn-orphans #-}
2module Network.BitTorrent.Exchange.BitfieldSpec (spec) where
3import Control.Applicative
4import Data.ByteString.Arbitrary
5import Test.Hspec
6import Test.QuickCheck
7
8import Network.BitTorrent.Exchange.Bitfield
9
10instance Arbitrary Bitfield where
11 arbitrary = fromBitmap . fromABS <$> arbitrary
12
13spec :: Spec
14spec = return ()
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/BlockSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/BlockSpec.hs
deleted file mode 100644
index 2dc8e0b8..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/BlockSpec.hs
+++ /dev/null
@@ -1,35 +0,0 @@
1module Network.BitTorrent.Exchange.BlockSpec (spec) where
2import Control.Applicative
3import Control.Exception
4import Data.Maybe
5import Test.Hspec
6import Test.QuickCheck
7import Test.QuickCheck.Instances ()
8
9import Network.BitTorrent.Exchange.Block as Block
10
11
12instance Arbitrary a => Arbitrary (Block a) where
13 arbitrary = Block <$> arbitrary <*> arbitrary <*> arbitrary
14
15instance Arbitrary BlockIx where
16 arbitrary = BlockIx <$> arbitrary <*> arbitrary <*> arbitrary
17
18instance Arbitrary Bucket where
19 arbitrary = do
20 s <- arbitrary `suchThat` (> 0)
21 chunks <- arbitrary
22 return $ Block.fromList s chunks
23
24isSomeException :: SomeException -> Bool
25isSomeException = const True
26
27spec :: Spec
28spec = do
29 describe "empty" $ do
30 it "should fail on bad size" $ do
31 evaluate (Block.empty (-1)) `shouldThrow` isSomeException
32
33 describe "toPiece" $ do
34 it "render to piece when it is full" $ property $ \ bkt ->
35 full bkt == isJust (toPiece bkt) \ No newline at end of file
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/ConnectionSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/ConnectionSpec.hs
deleted file mode 100644
index d654cda1..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/ConnectionSpec.hs
+++ /dev/null
@@ -1,58 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module Network.BitTorrent.Exchange.ConnectionSpec (spec) where
4import Control.Applicative
5import Control.Monad.Trans
6import Data.Default
7import Test.Hspec
8import Test.QuickCheck
9
10import Data.Torrent
11import Network.BitTorrent.Address
12import Network.BitTorrent.Exchange.Connection
13import Network.BitTorrent.Exchange.Message
14
15import Config
16import Network.BitTorrent.Exchange.MessageSpec ()
17
18nullSession :: InfoHash -> PeerId -> SessionLink ()
19nullSession ih pid = SessionLink ih pid Nothing Nothing ()
20
21instance Arbitrary Options where
22 arbitrary = return def
23
24instance Arbitrary ConnectionPrefs where
25 arbitrary = ConnectionPrefs <$> arbitrary <*> pure def
26 <*> arbitrary <*> arbitrary
27
28withWire :: ConnectionPrefs -> Wire () () -> IO ()
29withWire prefs wire =
30 withRemote $ \ ClientOpts {..} -> do
31 pid <- genPeerId
32 t <- getTestTorrent
33 let ih = idInfoHash (tInfoDict t)
34 let cfg = ConnectionConfig prefs (nullSession ih pid) (wire)
35 let addr = PeerAddr Nothing "127.0.0.1" peerPort
36 connectWire addr cfg
37
38spec :: Spec
39spec = do
40 describe "connectWire" $ do
41 it "can establish connection with all possible preferences" $
42 property $ \ prefs -> do
43 withWire prefs (return ())
44
45 it "must not connect with invalid topic" $ do
46 pending
47
48 describe "acceptWire" $ do
49 it "" $ do
50 pending
51
52 describe "messaging" $ do
53 it "first message is bitfield" $ do
54 withWire def $ do
55 msg <- recvMessage
56 let isBitfield (Available (Bitfield _)) = True
57 isBitfield _ = False
58 liftIO $ msg `shouldSatisfy` isBitfield
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/DownloadSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/DownloadSpec.hs
deleted file mode 100644
index d46f2034..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/DownloadSpec.hs
+++ /dev/null
@@ -1,59 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2module Network.BitTorrent.Exchange.DownloadSpec (spec) where
3import Control.Concurrent
4import Data.ByteString as BS
5import Data.ByteString.Lazy as BL
6import Test.Hspec
7import Test.QuickCheck
8
9import Data.BEncode as BE
10import Data.Torrent as Torrent
11import Network.BitTorrent.Address
12import Network.BitTorrent.Exchange.Download
13import Network.BitTorrent.Exchange.Message
14
15import Config
16import Network.BitTorrent.CoreSpec ()
17
18
19placeholderAddr :: PeerAddr IP
20placeholderAddr = "0.0.0.0:0"
21
22chunkBy :: Int -> BS.ByteString -> [BS.ByteString]
23chunkBy s bs
24 | BS.null bs = []
25 | otherwise = BS.take s bs : chunkBy s (BS.drop s bs)
26
27withUpdates :: Updates s a -> IO a
28withUpdates m = do
29 Torrent {..} <- getTestTorrent
30 let infoDictLen = fromIntegral $ BL.length $ BE.encode tInfoDict
31 --mvar <- newMVar (nullStatus infoDictLen)
32 --runUpdates mvar placeholderAddr m
33 undefined
34
35simulateFetch :: InfoDict -> Updates s (Maybe InfoDict)
36simulateFetch dict = undefined
37
38spec :: Spec
39spec = do
40 describe "scheduleBlock" $ do
41 it "never schedule the same index twice" $ do
42 pending
43
44 describe "resetPending" $ do
45 it "" $ do
46 pending
47
48 describe "cancelPending" $ do
49 it "must not throw an exception if cancel the same piece twice" $ do
50 pending
51
52 describe "pushBlock" $ do
53 it "assemble infodict from chunks" $ do
54 Torrent {..} <- getTestTorrent
55 mdict <- withUpdates $ simulateFetch tInfoDict
56 mdict `shouldBe` Just tInfoDict
57
58 it "must throw an exception if block if not requested" $ do
59 pending \ No newline at end of file
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/MessageSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/MessageSpec.hs
deleted file mode 100644
index d615b1ff..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/MessageSpec.hs
+++ /dev/null
@@ -1,102 +0,0 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2module Network.BitTorrent.Exchange.MessageSpec (spec) where
3import Control.Applicative
4import Control.Exception
5import Data.ByteString as BS
6import Data.List as L
7import Data.Set as S
8import Data.Serialize as S
9import Data.String
10import Test.Hspec
11import Test.QuickCheck
12
13import Data.TorrentSpec ()
14import Network.BitTorrent.Exchange.BitfieldSpec ()
15import Network.BitTorrent.CoreSpec ()
16import Network.BitTorrent.Address ()
17import Network.BitTorrent.Exchange.BlockSpec ()
18import Network.BitTorrent.Exchange.Message
19
20instance Arbitrary Extension where
21 arbitrary = elements [minBound .. maxBound]
22
23instance Arbitrary Caps where
24 arbitrary = toCaps <$> arbitrary
25
26instance Arbitrary ExtendedExtension where
27 arbitrary = elements [minBound .. maxBound]
28
29instance Arbitrary ExtendedCaps where
30 arbitrary = toCaps <$> arbitrary
31
32instance Arbitrary ProtocolName where
33 arbitrary = fromString <$> (arbitrary `suchThat` ((200 <) . L.length))
34
35instance Arbitrary Handshake where
36 arbitrary = Handshake <$> arbitrary <*> arbitrary
37 <*> arbitrary <*> arbitrary
38
39instance Arbitrary StatusUpdate where
40 arbitrary = frequency
41 [ (1, Choking <$> arbitrary)
42 , (1, Interested <$> arbitrary)
43 ]
44
45instance Arbitrary Available where
46 arbitrary = frequency
47 [ (1, Have <$> arbitrary)
48 , (1, Bitfield <$> arbitrary)
49 ]
50
51instance Arbitrary Transfer where
52 arbitrary = frequency
53 [ (1, Request <$> arbitrary)
54 , (1, Piece <$> arbitrary)
55 , (1, Cancel <$> arbitrary)
56 ]
57
58instance Arbitrary FastMessage where
59 arbitrary = frequency
60 [ (1, pure HaveAll)
61 , (1, pure HaveNone)
62 , (1, SuggestPiece <$> arbitrary)
63 , (1, RejectRequest <$> arbitrary)
64 , (1, AllowedFast <$> arbitrary)
65 ]
66
67instance Arbitrary Message where
68 arbitrary = frequency
69 [ (1, pure KeepAlive)
70 , (1, Status <$> arbitrary)
71 , (1, Available <$> arbitrary)
72 , (1, Transfer <$> arbitrary)
73 , (1, Fast <$> arbitrary)
74 ]
75
76-- TODO test extension protocol
77
78spec :: Spec
79spec = do
80 describe "Caps" $ do
81 it "set-like container" $ property $ \ exts ->
82 L.all (`allowed` (toCaps exts :: Caps)) exts
83
84 it "preserve items" $ property $ \ extSet ->
85 S.fromList (fromCaps (toCaps (S.toList extSet) :: Caps))
86 `shouldBe` extSet
87
88 describe "ByteStats" $ do
89 it "preserve size" $ property $ \ msg ->
90 byteLength (stats msg) `shouldBe`
91 fromIntegral (BS.length (S.encode (msg :: Message)))
92
93 describe "ProtocolName" $ do
94 it "fail to construct invalid string" $ do
95 let str = L.replicate 500 'x'
96 evaluate (fromString str :: ProtocolName)
97 `shouldThrow`
98 errorCall ("fromString: ProtocolName too long: " ++ str)
99
100 describe "Handshake" $ do
101 it "properly serialized" $ property $ \ hs ->
102 S.decode (S.encode hs ) `shouldBe` Right (hs :: Handshake)
diff --git a/bittorrent/tests/Network/BitTorrent/Exchange/SessionSpec.hs b/bittorrent/tests/Network/BitTorrent/Exchange/SessionSpec.hs
deleted file mode 100644
index bf5b95a1..00000000
--- a/bittorrent/tests/Network/BitTorrent/Exchange/SessionSpec.hs
+++ /dev/null
@@ -1,64 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2module Network.BitTorrent.Exchange.SessionSpec (spec) where
3import Test.Hspec
4
5import Data.Torrent
6import Network.BitTorrent.Address
7import Network.BitTorrent.Exchange.Session
8
9import Config
10
11
12nullLogger :: LogFun
13nullLogger _ _ x _ = print x
14
15simpleSession :: InfoDict -> (Session -> IO ()) -> IO ()
16simpleSession dict action = do
17 withRemoteAddr $ \ addr -> do
18 myAddr <- getMyAddr
19 ses <- newSession nullLogger myAddr "" (Right dict)
20 connect addr ses
21 action ses
22 closeSession ses
23
24spec :: Spec
25spec = do
26 describe "construction" $ do
27 describe "newSession" $ do
28 it "" $ do
29 pending
30
31 describe "closeSession" $ do
32 it "" $ do
33 pending
34
35 describe "connection set" $ do
36 describe "connect" $ do
37 it "" $ do
38 pending
39
40 describe "establish" $ do
41 it "" $ do
42 pending
43
44 describe "exchange" $ do
45 describe "metadata" $ do
46 it "should fetch info dictionary" $ do
47 Torrent {..} <- getTestTorrent
48 simpleSession tInfoDict $ \ ses -> do
49 dict <- waitMetadata ses
50 dict `shouldBe` tInfoDict
51
52 it "should serve info dictionary" $ do
53 pending
54
55 describe "content" $ do
56 it "should fetch torrent content" $ do
57 Torrent {..} <- getTestTorrent
58 simpleSession tInfoDict $ \ ses -> do
59 pending
60-- st <- waitData ses
61-- verifyStorage st (idPieceInfo tInfoDict)
62
63 it "should serve torrent content" $ do
64 pending
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-22 09:26:49 +0000