summaryrefslogtreecommitdiff
path: root/dht/bittorrent/tests/Data/TorrentSpec.hs
blob: b4a280e44098f48f4a04e00a78691eda213a05f3 (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
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# OPTIONS -fno-warn-orphans           #-}
module Data.TorrentSpec (spec) where
import Control.Applicative
import Data.BEncode
import Data.ByteString as BS
import Data.ByteString.Lazy as BL
import Data.Convertible
import Data.Maybe
import Data.Monoid
import Data.Time
import Network.URI
import System.FilePath
import System.Posix.Types
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Instances ()

import Data.Torrent
import Network.BitTorrent.CoreSpec ()


pico :: Gen (Maybe NominalDiffTime)
pico = oneof
  [ pure Nothing
  , (Just . fromIntegral) <$> (arbitrary :: Gen Int)
  ]

instance Arbitrary COff where
  arbitrary = fromIntegral <$> (arbitrary :: Gen Int)

instance Arbitrary URIAuth where
  arbitrary = URIAuth <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary URI where
  arbitrary
    = pure $ fromJust $ parseURI "http://ietf.org/1737.txt?a=1&b=h#123"

instance Arbitrary InfoHash where
  arbitrary = do
    bs <- BS.pack <$> vectorOf 20 arbitrary
    pure $ either (const (error "arbitrary infohash")) id $ safeConvert bs

instance Arbitrary a => Arbitrary (FileInfo a) where
  arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary LayoutInfo where
  arbitrary = oneof
    [ SingleFile <$> arbitrary
    , MultiFile  <$> arbitrary <*> arbitrary
    ]

instance Arbitrary a => Arbitrary (Piece a) where
  arbitrary = Piece <$> arbitrary <*> arbitrary

instance Arbitrary HashList where
  arbitrary = HashList <$> arbitrary

instance Arbitrary PieceInfo where
  arbitrary = PieceInfo <$> arbitrary <*> arbitrary

instance Arbitrary InfoDict where
  arbitrary = infoDictionary <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary Torrent where
  arbitrary = Torrent <$> arbitrary
                 <*> arbitrary <*> arbitrary    <*> arbitrary
                 <*> pico      <*> arbitrary    <*> arbitrary
                 <*> arbitrary
                 <*> arbitrary <*> pure Nothing <*> arbitrary

instance Arbitrary Magnet where
  arbitrary = Magnet <$> arbitrary <*> arbitrary
    <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    <*> arbitrary <*> arbitrary <*> pure mempty

type TestPair = (FilePath, String)

-- TODO add a few more torrents here
torrentList :: [TestPair]
torrentList =
  [ ( "res" </> "dapper-dvd-amd64.iso.torrent"
    , "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf")
  ]

infohashSpec :: (FilePath, String) -> Spec
infohashSpec (filepath, expectedHash) = do
  it ("should match " ++ filepath) $ do
    torrent    <- fromFile filepath
    let actualHash = show $ idInfoHash $ tInfoDict torrent
    actualHash `shouldBe` expectedHash

magnetEncoding :: Magnet -> IO ()
magnetEncoding m = parseMagnet (renderMagnet m) `shouldBe` Just m

data T a = T

prop_properBEncode :: Show a => BEncode a => Eq a
                   => T a -> a -> IO ()
prop_properBEncode _ expected = actual `shouldBe` Right expected
  where
    actual = decode $ BL.toStrict $ encode expected

spec :: Spec
spec = do
  describe "info hash" $ do
    mapM_ infohashSpec torrentList

  describe "accumPosition" $ do
    it "" $ property $ \ p1 p2 p3 s1 s2 s3 ->
      accumPositions [(p1, s1), (p2, s2), (p3, s3)]
        `shouldBe`   [(p1, (0, s1)), (p2, (s1, s2)), (p3, (s1 + s2, s3))]

  describe "FileInfo" $ do
    it "properly bencoded" $ property $
      prop_properBEncode (T :: T (FileInfo BS.ByteString))

  describe "LayoutInfo" $ do
    it "properly bencoded" $ property $
      prop_properBEncode (T :: T LayoutInfo)

  describe "Torrent" $ do
    it "property bencoded" $ property $
      prop_properBEncode (T :: T Torrent)

  describe "Magnet" $ do
    it "properly encoded" $ property $ magnetEncoding

    it "parse base32" $ do
      let magnet = "magnet:?xt=urn:btih:CT76LXJDDCH5LS2TUHKH6EUJ3NYKX4Y6"
      let ih = "CT76LXJDDCH5LS2TUHKH6EUJ3NYKX4Y6"
      parseMagnet magnet `shouldBe` Just (nullMagnet ih)

    it "parse base16" $ do
      let magnet = "magnet:?xt=urn:btih:0123456789abcdef0123456789abcdef01234567"
      let ih = "0123456789abcdef0123456789abcdef01234567"
      parseMagnet magnet `shouldBe` Just (nullMagnet ih)