1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.BitTorrent.Exchange.MessageSpec (spec) where
import Control.Applicative
import Control.Exception
import Data.ByteString as BS
import Data.List as L
import Data.Set as S
import Data.Serialize as S
import Data.String
import Test.Hspec
import Test.QuickCheck
import Data.Torrent.BitfieldSpec ()
import Data.Torrent.InfoHashSpec ()
import Network.BitTorrent.CoreSpec ()
import Network.BitTorrent.Core ()
import Network.BitTorrent.Exchange.BlockSpec ()
import Network.BitTorrent.Exchange.Message
instance Arbitrary Extension where
arbitrary = elements [minBound .. maxBound]
instance Arbitrary Caps where
arbitrary = toCaps <$> arbitrary
instance Arbitrary ExtendedExtension where
arbitrary = elements [minBound .. maxBound]
instance Arbitrary ExtendedCaps where
arbitrary = toCaps <$> arbitrary
instance Arbitrary ProtocolName where
arbitrary = fromString <$> (arbitrary `suchThat` ((200 <) . L.length))
instance Arbitrary Handshake where
arbitrary = Handshake <$> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
instance Arbitrary StatusUpdate where
arbitrary = frequency
[ (1, Choking <$> arbitrary)
, (1, Interested <$> arbitrary)
]
instance Arbitrary Available where
arbitrary = frequency
[ (1, Have <$> arbitrary)
, (1, Bitfield <$> arbitrary)
]
instance Arbitrary Transfer where
arbitrary = frequency
[ (1, Request <$> arbitrary)
, (1, Piece <$> arbitrary)
, (1, Cancel <$> arbitrary)
]
instance Arbitrary FastMessage where
arbitrary = frequency
[ (1, pure HaveAll)
, (1, pure HaveNone)
, (1, SuggestPiece <$> arbitrary)
, (1, RejectRequest <$> arbitrary)
, (1, AllowedFast <$> arbitrary)
]
instance Arbitrary Message where
arbitrary = frequency
[ (1, pure KeepAlive)
, (1, Status <$> arbitrary)
, (1, Available <$> arbitrary)
, (1, Transfer <$> arbitrary)
, (1, Fast <$> arbitrary)
]
-- TODO test extension protocol
spec :: Spec
spec = do
describe "Caps" $ do
it "set-like container" $ property $ \ exts ->
L.all (`allowed` (toCaps exts :: Caps)) exts
it "preserve items" $ property $ \ extSet ->
S.fromList (fromCaps (toCaps (S.toList extSet) :: Caps))
`shouldBe` extSet
describe "ByteStats" $ do
it "preserve size" $ property $ \ msg ->
byteLength (stats msg) `shouldBe`
fromIntegral (BS.length (S.encode (msg :: Message)))
describe "ProtocolName" $ do
it "fail to construct invalid string" $ do
let str = L.replicate 500 'x'
evaluate (fromString str :: ProtocolName)
`shouldThrow`
errorCall ("fromString: ProtocolName too long: " ++ str)
describe "Handshake" $ do
it "properly serialized" $ property $ \ hs ->
S.decode (S.encode hs ) `shouldBe` Right (hs :: Handshake)
|
