summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/Tracker/MessageSpec.hs
blob: 87d9f19169f134007b51c26d7c2226d0deacf1e3 (plain)
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
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.Torrent.InfoHashSpec ()
import Data.Torrent.ProgressSpec ()
import Network.BitTorrent.Core.PeerIdSpec ()
import Network.BitTorrent.Core.PeerAddrSpec ()

import Network.BitTorrent.Tracker.Message as Message
import Network.BitTorrent.Core


--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 Event 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 ()