~ Fix bug in torrent bencode instance.

Also add encoding tests for torrent module.

4 files changed, 95 insertions, 20 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 138f5d3b..e0f6df5a 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -118,11 +118,13 @@ test-suite properties
                      , bytestring >= 0.10.2
                      , cereal     >= 0.3.5.2
                      , network    >= 2.4.0.13
+                     , text
 
                      , test-framework
                      , test-framework-quickcheck2
                      , QuickCheck
 
+                     , bencoding
                      , bittorrent
                      , intset
 
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 16b94828..3175e151 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -17,6 +17,7 @@
 --   <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure>
 --
 {-# OPTIONS -fno-warn-orphans #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
@@ -24,6 +25,7 @@
 module Data.Torrent
        ( -- * Torrent
          Torrent(..), ContentInfo(..), FileInfo(..)
+       , torrent, simpleTorrent
        , fromFile
 
          -- * Files layout
@@ -32,15 +34,21 @@ module Data.Torrent
        , isSingleFile, isMultiFile
 
          -- * Info hash
-       , InfoHash, ppInfoHash
-       , hash, hashlazy
+#if defined (TESTING)
+       , InfoHash(..)
+#else
+       , InfoHash
+#endif
+       , ppInfoHash
        , addHashToURI
 
          -- * Extra
        , sizeInBase
 
+#if defined (TESTING)
          -- * Internal
-       , InfoHash(..)
+       , hash, hashlazy
+#endif
        ) where
 
 import Prelude hiding (sum)
@@ -79,6 +87,10 @@ data Torrent = Torrent {
     , tAnnounce     ::       URI
       -- ^ The URL of the tracker.
 
+      -- NOTE: out of lexicographic order!
+    , tInfo         :: ContentInfo
+      -- ^ Info about each content file.
+
     , tAnnounceList :: Maybe [[URI]]
       -- ^ Announce list add multiple tracker support.
       --
@@ -97,9 +109,6 @@ data Torrent = Torrent {
       -- ^ String encoding format used to generate the pieces part of
       --   the info dictionary in the .torrent metafile.
 
-    , tInfo         :: ContentInfo
-      -- ^ Info about each content file.
-
     , tPublisher    :: Maybe URI
       -- ^ Containing the RSA public key of the publisher of the torrent.
       --   Private counterpart of this key that has the authority to allow
@@ -109,7 +118,26 @@ data Torrent = Torrent {
     , tSignature    :: Maybe ByteString
       -- ^ The RSA signature of the info dictionary (specifically,
       --   the encrypted SHA-1 hash of the info dictionary).
-    } deriving Show
+    } deriving (Show, Eq)
+
+{- note that info hash is actually reduntant field
+   but it's better to keep it here to avoid heavy recomputations
+-}
+
+-- | Smart constructor for 'Torrent' which compute info hash.
+torrent :: URI            -> ContentInfo
+        -> Maybe [[URI]]  -> Maybe Text       -> Maybe ByteString
+        -> Maybe Time     -> Maybe ByteString -> Maybe URI
+        -> Maybe URI      -> Maybe ByteString
+        -> Torrent
+torrent announce info = Torrent (hashlazy (BE.encoded info)) announce info
+
+-- | A simple torrent contains only required fields.
+simpleTorrent :: URI -> ContentInfo -> Torrent
+simpleTorrent announce info = torrent announce info
+                              Nothing Nothing Nothing
+                              Nothing Nothing Nothing
+                              Nothing Nothing
 
 -- | Info part of the .torrent file contain info about each content file.
 data ContentInfo =
@@ -133,8 +161,9 @@ data ContentInfo =
       -- ^ Concatenation of all 20-byte SHA1 hash values.
 
     , ciPrivate      :: Maybe Bool
-      -- ^ If set the client MUST publish its presence to get other peers ONLY
-      --   via the trackers explicity described in the metainfo file.
+      -- ^ If set the client MUST publish its presence to get other
+      -- peers ONLY via the trackers explicity described in the
+      -- metainfo file.
       --
       --   BEP 27: <http://www.bittorrent.org/beps/bep_0027.html>
     }
@@ -162,10 +191,10 @@ data FileInfo = FileInfo {
       --   Used by third-party tools, not by bittorrent protocol itself.
 
     , fiPath        :: [ByteString]
-      -- ^ One or more string elements that together represent the path and
-      --   filename. Each element in the list corresponds to either a directory
-      --   name or (in the case of the last element) the filename.
-      --   For example, the file
+      -- ^ One or more string elements that together represent the
+      --   path and filename. Each element in the list corresponds to
+      --   either a directory name or (in the case of the last
+      --   element) the filename.  For example, the file:
       --
       --   > "dir1/dir2/file.ext"
       --
@@ -201,15 +230,15 @@ instance BEncodable Torrent where
   fromBEncode (BDict d) | Just info <- M.lookup "info" d =
     Torrent <$> pure (hashlazy (BE.encode info)) -- WARN
             <*> d >--  "announce"
+            <*> d >--  "info"
             <*> d >--? "announce-list"
             <*> d >--? "comment"
             <*> d >--? "created by"
             <*> d >--? "creation date"
             <*> d >--? "encoding"
-            <*> d >--  "info"
             <*> d >--? "publisher"
             <*> d >--? "publisher-url"
-            <*> d >--? "singature"
+            <*> d >--? "signature"
 
   fromBEncode _ = decodingError "Torrent"
 
diff --git a/tests/Encoding.hs b/tests/Encoding.hs
index a599cd39..78f0dfc1 100644
--- a/tests/Encoding.hs
+++ b/tests/Encoding.hs
@@ -48,12 +48,12 @@ instance Arbitrary Message where
     , pure Unchoke
     , pure Interested
     , pure NotInterested
-    , Have <$> positive
+    , Have     <$> positive
     , Bitfield <$> arbitrary
-    , Request <$> arbitrary
-    , Piece <$> arbitrary
-    , Cancel <$> arbitrary
-    , Port <$> arbitrary
+    , Request  <$> arbitrary
+    , Piece    <$> arbitrary
+    , Cancel   <$> arbitrary
+    , Port     <$> arbitrary
     ]
 
 instance Arbitrary PeerID where
@@ -67,6 +67,7 @@ instance Arbitrary InfoHash where
 instance Arbitrary Handshake where
   arbitrary = defaultHandshake <$> arbitrary <*> arbitrary
 
+
 data T a = T
 
 prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool
diff --git a/tests/Main.hs b/tests/Main.hs
index 0aa6423f..ff571b6b 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -2,20 +2,35 @@
 module Main (main) where
 
 import Control.Applicative
+import qualified Data.ByteString.Lazy as Lazy
 import Data.IntervalSet
 import Data.List as L
 import Data.Ord
+import Data.Maybe
 import Data.Word
+import Data.Text as T
+import Network.URI
 
 import Test.Framework (defaultMain)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
 
+import Data.BEncode
 import Data.Bitfield as BF
+import Data.Torrent
 import Network.BitTorrent as BT
 
+import Debug.Trace
 import Encoding
 
+
+instance Arbitrary URI where
+  arbitrary = pure $ fromJust
+              $ parseURI "http://exsample.com:80/123365_asd"
+
+instance Arbitrary Text where
+  arbitrary = T.pack <$> arbitrary
+
 {-----------------------------------------------------------------------
     Bitfield
 -----------------------------------------------------------------------}
@@ -51,8 +66,29 @@ prop_differenceDeMorgan a b c =
     Torrent
 -----------------------------------------------------------------------}
 
+prop_properBEncode :: Show a => BEncodable a => Eq a => T a -> a -> Bool
+prop_properBEncode _ expected = actual == Right expected
+  where
+    actual = decoded $ Lazy.toStrict $ encoded expected
+
+
 -- TODO tests for torrent: encoding <-> decoding
+instance Arbitrary FileInfo where
+  arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary
 
+instance Arbitrary ContentInfo where
+  arbitrary = oneof
+    [ SingleFile <$> arbitrary <*> arbitrary <*> arbitrary
+                 <*> arbitrary <*> arbitrary <*> arbitrary
+    , MultiFile  <$> arbitrary <*> arbitrary <*> arbitrary
+                 <*> arbitrary <*> arbitrary
+    ]
+
+instance Arbitrary Torrent where
+  arbitrary = torrent <$> arbitrary
+                 <*> arbitrary <*> arbitrary <*> arbitrary
+                 <*> arbitrary <*> arbitrary <*> arbitrary
+                 <*> arbitrary <*> pure Nothing <*> arbitrary
 
 main :: IO ()
 main = defaultMain
@@ -60,4 +96,11 @@ main = defaultMain
   , testProperty "rarest in range"         prop_rarestInRange
   , testProperty "min less that max"       prop_minMax
   , testProperty "difference de morgan"    prop_differenceDeMorgan
+
+  , testProperty "file info encoding"      $
+      prop_properBEncode (T :: T FileInfo)
+  , testProperty "content info encoding"   $
+      prop_properBEncode (T :: T ContentInfo)
+  , testProperty "torrent encoding" $
+      prop_properBEncode (T :: T Torrent)
   ]