From 88ef120511caae5ed74a48a87617b43aec4b7f76 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Fri, 4 Apr 2014 21:16:34 +0400
Subject: Move layout info to Torrent module

---
 src/System/Torrent/FileMap.hs | 2 +-
 src/System/Torrent/Storage.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

(limited to 'src/System/Torrent')

diff --git a/src/System/Torrent/FileMap.hs b/src/System/Torrent/FileMap.hs
index 80907a30..6e8d7f5a 100644
--- a/src/System/Torrent/FileMap.hs
+++ b/src/System/Torrent/FileMap.hs
@@ -34,7 +34,7 @@ import Data.Vector as V -- TODO use unboxed vector
 import Foreign
 import System.IO.MMap
 
-import Data.Torrent.Layout
+import Data.Torrent
 
 
 data FileEntry = FileEntry
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index 003a4e98..697e3def 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -57,7 +57,7 @@ import Data.Typeable
 
 import Data.Torrent
 import Data.Torrent.Bitfield as BF
-import Data.Torrent.Layout
+import Data.Torrent
 import Data.Torrent.Piece
 import System.Torrent.FileMap as FM
 
-- 
cgit v1.2.3


From 052bed30a3d83aa8fb7b8b42509ad96f573439af Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Fri, 4 Apr 2014 21:44:18 +0400
Subject: Move HashList to Torrent module

---
 bittorrent.cabal                                   |   1 -
 src/Data/Torrent.hs                                | 199 +++++++++++++++++-
 src/Data/Torrent/Bitfield.hs                       |   2 +-
 src/Data/Torrent/Piece.hs                          | 232 ---------------------
 src/Network/BitTorrent/DHT/Session.hs              |   2 +-
 src/Network/BitTorrent/Exchange/Assembler.hs       |   2 +-
 src/Network/BitTorrent/Exchange/Block.hs           |   2 +-
 src/Network/BitTorrent/Exchange/Message.hs         |  10 +-
 src/Network/BitTorrent/Exchange/Session.hs         |   3 +-
 .../BitTorrent/Exchange/Session/Metadata.hs        |   1 -
 src/Network/BitTorrent/Exchange/Session/Status.hs  |   2 +-
 src/System/Torrent/Storage.hs                      |   2 -
 tests/Data/Torrent/MetainfoSpec.hs                 |   1 -
 tests/Data/Torrent/PieceSpec.hs                    |   2 +-
 .../BitTorrent/Exchange/Session/MetadataSpec.hs    |   5 +-
 tests/System/Torrent/StorageSpec.hs                |   3 +-
 16 files changed, 213 insertions(+), 256 deletions(-)
 delete mode 100644 src/Data/Torrent/Piece.hs

(limited to 'src/System/Torrent')

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 9d687d7d..9a86702d 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -46,7 +46,6 @@ library
   hs-source-dirs:      src
   exposed-modules:     Data.Torrent
                        Data.Torrent.Bitfield
-                       Data.Torrent.Piece
                        Data.Torrent.Progress
                        Data.Torrent.Tree
                        Network.BitTorrent
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 701da9dd..98d6f94e 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -86,6 +86,34 @@ module Data.Torrent
          -- ** Internal
        , sizeInBase
 
+         -- * Pieces
+         -- ** Attributes
+       , PieceIx
+       , PieceCount
+       , PieceSize
+       , minPieceSize
+       , maxPieceSize
+       , defaultPieceSize
+       , PieceHash
+
+         -- ** Piece data
+       , Piece (..)
+       , pieceSize
+       , hashPiece
+
+         -- ** Piece control
+       , HashList (..)
+       , PieceInfo (..)
+       , pieceCount
+
+         -- ** Lens
+       , pieceLength
+       , pieceHashes
+
+         -- ** Validation
+       , pieceHash
+       , checkPieceLazy
+
          -- * Info dictionary
        , InfoDict (..)
        , infoDictionary
@@ -133,8 +161,11 @@ import Control.Exception
 import Control.Lens hiding (unsnoc)
 import Control.Monad
 import qualified Crypto.Hash.SHA1 as C
+import qualified Crypto.Hash.SHA1 as SHA1
 import Data.BEncode as BE
 import Data.BEncode.Types as BE
+import Data.Bits
+import Data.Bits.Extras
 import           Data.ByteString as BS
 import           Data.ByteString.Base16 as Base16
 import           Data.ByteString.Base32 as Base32
@@ -146,6 +177,7 @@ import           Data.Convertible
 import           Data.Default
 import           Data.Foldable as F
 import           Data.Hashable   as Hashable
+import           Data.Int
 import qualified Data.List as L
 import           Data.Map as M
 import           Data.Maybe
@@ -166,7 +198,6 @@ import Text.PrettyPrint.Class
 import System.FilePath
 import System.Posix.Types
 
-import Data.Torrent.Piece
 import Network.BitTorrent.Core.NodeInfo
 
 
@@ -526,6 +557,171 @@ sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align
 {-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}
 {-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
 
+{-----------------------------------------------------------------------
+-- Piece attributes
+-----------------------------------------------------------------------}
+
+-- | Zero-based index of piece in torrent content.
+type PieceIx   = Int
+
+-- | Size of piece in bytes. Should be a power of 2.
+--
+--   NOTE: Have max and min size constrained to wide used
+--   semi-standard values. This bounds should be used to make decision
+--   about piece size for new torrents.
+--
+type PieceSize = Int
+
+-- | Number of pieces in torrent or a part of torrent.
+type PieceCount = Int
+
+defaultBlockSize :: Int
+defaultBlockSize = 16 * 1024
+
+-- | Optimal number of pieces in torrent.
+optimalPieceCount :: PieceCount
+optimalPieceCount = 1000
+{-# INLINE optimalPieceCount #-}
+
+-- | Piece size should not be less than this value.
+minPieceSize :: Int
+minPieceSize = defaultBlockSize * 4
+{-# INLINE minPieceSize #-}
+
+-- | To prevent transfer degradation piece size should not exceed this
+-- value.
+maxPieceSize :: Int
+maxPieceSize = 4 * 1024 * 1024
+{-# INLINE maxPieceSize #-}
+
+toPow2 :: Int -> Int
+toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)
+
+-- | Find the optimal piece size for a given torrent size.
+defaultPieceSize :: Int64 -> Int
+defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc
+  where
+    pc = fromIntegral (x `div` fromIntegral optimalPieceCount)
+
+{-----------------------------------------------------------------------
+-- Piece data
+-----------------------------------------------------------------------}
+
+type PieceHash = ByteString
+
+hashsize :: Int
+hashsize = 20
+{-# INLINE hashsize #-}
+
+-- TODO check if pieceLength is power of 2
+-- | Piece payload should be strict or lazy bytestring.
+data Piece a = Piece
+  { -- | Zero-based piece index in torrent.
+    pieceIndex :: {-# UNPACK #-} !PieceIx
+
+    -- | Payload.
+  , pieceData  :: !a
+  } deriving (Show, Read, Eq, Functor, Typeable)
+
+instance NFData (Piece a)
+
+-- | Payload bytes are omitted.
+instance Pretty (Piece a) where
+  pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
+
+-- | Get size of piece in bytes.
+pieceSize :: Piece BL.ByteString -> PieceSize
+pieceSize Piece {..} = fromIntegral (BL.length pieceData)
+
+-- | Get piece hash.
+hashPiece :: Piece BL.ByteString -> PieceHash
+hashPiece Piece {..} = SHA1.hashlazy pieceData
+
+{-----------------------------------------------------------------------
+-- Piece control
+-----------------------------------------------------------------------}
+
+-- | A flat array of SHA1 hash for each piece.
+newtype HashList = HashList { unHashList :: ByteString }
+  deriving (Show, Read, Eq, BEncode, Typeable)
+
+-- | Empty hash list.
+instance Default HashList where
+  def = HashList ""
+
+-- | Part of torrent file used for torrent content validation.
+data PieceInfo = PieceInfo
+  { piPieceLength  :: {-# UNPACK #-} !PieceSize
+    -- ^ Number of bytes in each piece.
+
+  , piPieceHashes  :: !HashList
+    -- ^ Concatenation of all 20-byte SHA1 hash values.
+  } deriving (Show, Read, Eq, Typeable)
+
+-- | Number of bytes in each piece.
+makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
+
+-- | Concatenation of all 20-byte SHA1 hash values.
+makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo
+
+instance NFData PieceInfo
+
+instance Default PieceInfo where
+  def = PieceInfo 1 def
+
+class Lint a where
+   lint :: a -> Either String a
+
+instance Lint PieceInfo where
+  lint pinfo @ PieceInfo {..}
+    | BS.length (unHashList piPieceHashes) `rem` hashsize == 0
+    , piPieceLength >= 0 = return pinfo
+    |       otherwise    = Left undefined
+
+
+putPieceInfo :: Data.Torrent.Put PieceInfo
+putPieceInfo PieceInfo {..} cont =
+       "piece length" .=! piPieceLength
+    .: "pieces"       .=! piPieceHashes
+    .: cont
+
+getPieceInfo :: BE.Get PieceInfo
+getPieceInfo = do
+    PieceInfo <$>! "piece length"
+              <*>! "pieces"
+
+instance BEncode PieceInfo where
+  toBEncode   = toDict . (`putPieceInfo` endDict)
+  fromBEncode = fromDict getPieceInfo
+
+-- | Hashes are omitted.
+instance Pretty PieceInfo where
+  pretty  PieceInfo {..} = "Piece size: " <> int piPieceLength
+
+slice :: Int -> Int -> ByteString -> ByteString
+slice start len = BS.take len . BS.drop start
+{-# INLINE slice #-}
+
+-- | Extract validation hash by specified piece index.
+pieceHash :: PieceInfo -> PieceIx -> PieceHash
+pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashList piPieceHashes)
+
+-- | Find count of pieces in the torrent. If torrent size is not a
+-- multiple of piece size then the count is rounded up.
+pieceCount :: PieceInfo -> PieceCount
+pieceCount PieceInfo {..} = BS.length (unHashList piPieceHashes) `quot` hashsize
+
+-- | Test if this is last piece in torrent content.
+isLastPiece :: PieceInfo -> PieceIx -> Bool
+isLastPiece ci i = pieceCount ci == succ i
+
+-- | Validate piece with metainfo hash.
+checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool
+checkPieceLazy pinfo @ PieceInfo {..} Piece {..}
+  = (fromIntegral (BL.length pieceData) == piPieceLength
+     || isLastPiece pinfo pieceIndex)
+  && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
+
 {-----------------------------------------------------------------------
 --  Info dictionary
 -----------------------------------------------------------------------}
@@ -620,6 +816,7 @@ instance Pretty InfoDict where
 {-----------------------------------------------------------------------
 --  Torrent info
 -----------------------------------------------------------------------}
+-- TODO add torrent file validation
 
 -- | Metainfo about particular torrent.
 data Torrent = Torrent
diff --git a/src/Data/Torrent/Bitfield.hs b/src/Data/Torrent/Bitfield.hs
index b65f058b..ff701d75 100644
--- a/src/Data/Torrent/Bitfield.hs
+++ b/src/Data/Torrent/Bitfield.hs
@@ -92,7 +92,7 @@ import           Data.List (foldl')
 import           Data.Monoid
 import           Data.Ratio
 
-import Data.Torrent.Piece
+import Data.Torrent
 
 -- TODO cache some operations
 
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
deleted file mode 100644
index d4b2c399..00000000
--- a/src/Data/Torrent/Piece.hs
+++ /dev/null
@@ -1,232 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Pieces are used to validate torrent content.
---
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Data.Torrent.Piece
-       ( -- * Piece attributes
-         PieceIx
-       , PieceCount
-       , PieceSize
-       , minPieceSize
-       , maxPieceSize
-       , defaultPieceSize
-       , PieceHash
-
-         -- * Piece data
-       , Piece (..)
-       , pieceSize
-       , hashPiece
-
-         -- * Piece control
-       , HashList (..)
-       , PieceInfo (..)
-       , pieceCount
-
-         -- * Lens
-       , pieceLength
-       , pieceHashes
-
-         -- * Validation
-       , pieceHash
-       , checkPieceLazy
-
-         -- * Internal
-       , getPieceInfo
-       , putPieceInfo
-       ) where
-
-import Control.DeepSeq
-import Control.Lens
-import qualified Crypto.Hash.SHA1 as SHA1
-import Data.BEncode
-import Data.BEncode.Types
-import Data.Bits
-import Data.Bits.Extras
-import           Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Base64 as Base64
-import Data.Default
-import Data.Int
-import Data.Text.Encoding as T
-import Data.Typeable
-import Text.PrettyPrint
-import Text.PrettyPrint.Class
-
-
--- TODO add torrent file validation
-class Lint a where
-   lint :: a -> Either String a
-
---class Validation a where
---  validate :: PieceInfo -> Piece a -> Bool
-
-{-----------------------------------------------------------------------
--- Piece attributes
------------------------------------------------------------------------}
-
--- | Zero-based index of piece in torrent content.
-type PieceIx   = Int
-
--- | Size of piece in bytes. Should be a power of 2.
---
---   NOTE: Have max and min size constrained to wide used
---   semi-standard values. This bounds should be used to make decision
---   about piece size for new torrents.
---
-type PieceSize = Int
-
--- | Number of pieces in torrent or a part of torrent.
-type PieceCount = Int
-
-defaultBlockSize :: Int
-defaultBlockSize = 16 * 1024
-
--- | Optimal number of pieces in torrent.
-optimalPieceCount :: PieceCount
-optimalPieceCount = 1000
-{-# INLINE optimalPieceCount #-}
-
--- | Piece size should not be less than this value.
-minPieceSize :: Int
-minPieceSize = defaultBlockSize * 4
-{-# INLINE minPieceSize #-}
-
--- | To prevent transfer degradation piece size should not exceed this
--- value.
-maxPieceSize :: Int
-maxPieceSize = 4 * 1024 * 1024
-{-# INLINE maxPieceSize #-}
-
-toPow2 :: Int -> Int
-toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)
-
--- | Find the optimal piece size for a given torrent size.
-defaultPieceSize :: Int64 -> Int
-defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc
-  where
-    pc = fromIntegral (x `div` fromIntegral optimalPieceCount)
-
-{-----------------------------------------------------------------------
--- Piece data
------------------------------------------------------------------------}
-
-type PieceHash = ByteString
-
-hashsize :: Int
-hashsize = 20
-{-# INLINE hashsize #-}
-
--- TODO check if pieceLength is power of 2
--- | Piece payload should be strict or lazy bytestring.
-data Piece a = Piece
-  { -- | Zero-based piece index in torrent.
-    pieceIndex :: {-# UNPACK #-} !PieceIx
-
-    -- | Payload.
-  , pieceData  :: !a
-  } deriving (Show, Read, Eq, Functor, Typeable)
-
-instance NFData (Piece a)
-
--- | Payload bytes are omitted.
-instance Pretty (Piece a) where
-  pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
-
--- | Get size of piece in bytes.
-pieceSize :: Piece BL.ByteString -> PieceSize
-pieceSize Piece {..} = fromIntegral (BL.length pieceData)
-
--- | Get piece hash.
-hashPiece :: Piece BL.ByteString -> PieceHash
-hashPiece Piece {..} = SHA1.hashlazy pieceData
-
-{-----------------------------------------------------------------------
--- Piece control
------------------------------------------------------------------------}
-
--- | A flat array of SHA1 hash for each piece.
-newtype HashList = HashList { unHashList :: ByteString }
-  deriving (Show, Read, Eq, BEncode, Typeable)
-
--- | Empty hash list.
-instance Default HashList where
-  def = HashList ""
-
--- | Part of torrent file used for torrent content validation.
-data PieceInfo = PieceInfo
-  { piPieceLength  :: {-# UNPACK #-} !PieceSize
-    -- ^ Number of bytes in each piece.
-
-  , piPieceHashes  :: !HashList
-    -- ^ Concatenation of all 20-byte SHA1 hash values.
-  } deriving (Show, Read, Eq, Typeable)
-
--- | Number of bytes in each piece.
-makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
-
--- | Concatenation of all 20-byte SHA1 hash values.
-makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo
-
-instance NFData PieceInfo
-
-instance Default PieceInfo where
-  def = PieceInfo 1 def
-
-instance Lint PieceInfo where
-  lint pinfo @ PieceInfo {..}
-    | BS.length (unHashList piPieceHashes) `rem` hashsize == 0
-    , piPieceLength >= 0 = return pinfo
-    |       otherwise    = Left undefined
-
-
-putPieceInfo :: PieceInfo -> BDict -> BDict
-putPieceInfo PieceInfo {..} cont =
-       "piece length" .=! piPieceLength
-    .: "pieces"       .=! piPieceHashes
-    .: cont
-
-getPieceInfo :: Get PieceInfo
-getPieceInfo = do
-    PieceInfo <$>! "piece length"
-              <*>! "pieces"
-
-instance BEncode PieceInfo where
-  toBEncode   = toDict . (`putPieceInfo` endDict)
-  fromBEncode = fromDict getPieceInfo
-
--- | Hashes are omitted.
-instance Pretty PieceInfo where
-  pretty  PieceInfo {..} = "Piece size: " <> int piPieceLength
-
-slice :: Int -> Int -> ByteString -> ByteString
-slice start len = BS.take len . BS.drop start
-{-# INLINE slice #-}
-
--- | Extract validation hash by specified piece index.
-pieceHash :: PieceInfo -> PieceIx -> PieceHash
-pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashList piPieceHashes)
-
--- | Find count of pieces in the torrent. If torrent size is not a
--- multiple of piece size then the count is rounded up.
-pieceCount :: PieceInfo -> PieceCount
-pieceCount PieceInfo {..} = BS.length (unHashList piPieceHashes) `quot` hashsize
-
--- | Test if this is last piece in torrent content.
-isLastPiece :: PieceInfo -> PieceIx -> Bool
-isLastPiece ci i = pieceCount ci == succ i
-
--- | Validate piece with metainfo hash.
-checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool
-checkPieceLazy pinfo @ PieceInfo {..} Piece {..}
-  = (fromIntegral (BL.length pieceData) == piPieceLength
-     || isLastPiece pinfo pieceIndex)
-  && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 87a6d4ea..8fe81abd 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -91,7 +91,7 @@ import System.Random (randomIO)
 import Text.PrettyPrint as PP hiding ((<>), ($$))
 import Text.PrettyPrint.Class
 
-import Data.Torrent
+import Data.Torrent as Torrent
 import Network.KRPC hiding (Options, def)
 import qualified Network.KRPC as KRPC (def)
 import Network.BitTorrent.Core
diff --git a/src/Network/BitTorrent/Exchange/Assembler.hs b/src/Network/BitTorrent/Exchange/Assembler.hs
index e5834948..e17dfbe2 100644
--- a/src/Network/BitTorrent/Exchange/Assembler.hs
+++ b/src/Network/BitTorrent/Exchange/Assembler.hs
@@ -67,7 +67,7 @@ import Data.Map as M
 import Data.Maybe
 import Data.IP
 
-import Data.Torrent.Piece
+import Data.Torrent
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Block as B
 
diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs
index 16c124e9..ccc7a0a9 100644
--- a/src/Network/BitTorrent/Exchange/Block.hs
+++ b/src/Network/BitTorrent/Exchange/Block.hs
@@ -69,7 +69,7 @@ import Numeric
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.Piece
+import Data.Torrent
 
 {-----------------------------------------------------------------------
 --  Block attributes
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index bd5c6526..5ca7c97e 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -118,8 +118,8 @@ import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
 import Data.Torrent.Bitfield
-import Data.Torrent
-import qualified Data.Torrent.Piece as P
+import Data.Torrent hiding (Piece (..))
+import qualified Data.Torrent as P (Piece (..))
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Block
 
@@ -864,7 +864,7 @@ instance PeerMessage ExtendedMetadata where
 
 -- | All 'Piece's in 'MetadataData' messages MUST have size equal to
 -- this value. The last trailing piece can be shorter.
-metadataPieceSize :: P.PieceSize
+metadataPieceSize :: PieceSize
 metadataPieceSize = 16 * 1024
 
 isLastPiece :: P.Piece a -> Int -> Bool
@@ -877,8 +877,8 @@ isLastPiece P.Piece {..} total = succ pieceIndex == pcnt
 -- length; otherwise serialization MUST fail.
 isValidPiece :: P.Piece BL.ByteString -> Int -> Bool
 isValidPiece p @ P.Piece {..} total
-  | isLastPiece p total = P.pieceSize p <= metadataPieceSize
-  |       otherwise     = P.pieceSize p == metadataPieceSize
+  | isLastPiece p total = pieceSize p <= metadataPieceSize
+  |       otherwise     = pieceSize p == metadataPieceSize
 
 setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata
 setMetadataPayload bs (MetadataData (P.Piece pix _) t) =
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index 0adb08c8..cae3a2d5 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -45,8 +45,7 @@ import Text.PrettyPrint.Class
 import System.Log.FastLogger (LogStr, ToLogStr (..))
 
 import Data.BEncode as BE
-import Data.Torrent as T
-import Data.Torrent.Piece as Torrent
+import Data.Torrent as Torrent
 import Data.Torrent.Bitfield as BF
 import Network.BitTorrent.Internal.Types
 import Network.BitTorrent.Core
diff --git a/src/Network/BitTorrent/Exchange/Session/Metadata.hs b/src/Network/BitTorrent/Exchange/Session/Metadata.hs
index bdd5b322..a4e54659 100644
--- a/src/Network/BitTorrent/Exchange/Session/Metadata.hs
+++ b/src/Network/BitTorrent/Exchange/Session/Metadata.hs
@@ -27,7 +27,6 @@ import Data.Tuple
 
 import Data.BEncode as BE
 import Data.Torrent as Torrent
-import Data.Torrent.Piece as Torrent
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Block   as Block
 import Network.BitTorrent.Exchange.Message as Message hiding (Status)
diff --git a/src/Network/BitTorrent/Exchange/Session/Status.hs b/src/Network/BitTorrent/Exchange/Session/Status.hs
index 565c3bf3..4feff8d6 100644
--- a/src/Network/BitTorrent/Exchange/Session/Status.hs
+++ b/src/Network/BitTorrent/Exchange/Session/Status.hs
@@ -28,7 +28,7 @@ import Data.Map as M
 import Data.Set as S
 import Data.Tuple
 
-import Data.Torrent.Piece
+import Data.Torrent
 import Data.Torrent.Bitfield as BF
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Block as Block
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index 697e3def..1123cea9 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -57,8 +57,6 @@ import Data.Typeable
 
 import Data.Torrent
 import Data.Torrent.Bitfield as BF
-import Data.Torrent
-import Data.Torrent.Piece
 import System.Torrent.FileMap as FM
 
 
diff --git a/tests/Data/Torrent/MetainfoSpec.hs b/tests/Data/Torrent/MetainfoSpec.hs
index 537b3f99..1a8f97c7 100644
--- a/tests/Data/Torrent/MetainfoSpec.hs
+++ b/tests/Data/Torrent/MetainfoSpec.hs
@@ -14,7 +14,6 @@ import Test.QuickCheck
 import Test.QuickCheck.Instances ()
 
 import Data.Torrent
-import Data.Torrent.Piece
 import Data.Torrent.LayoutSpec ()
 import Network.BitTorrent.Core.NodeInfoSpec ()
 
diff --git a/tests/Data/Torrent/PieceSpec.hs b/tests/Data/Torrent/PieceSpec.hs
index ef1f2938..d3933396 100644
--- a/tests/Data/Torrent/PieceSpec.hs
+++ b/tests/Data/Torrent/PieceSpec.hs
@@ -3,7 +3,7 @@ module Data.Torrent.PieceSpec (spec) where
 import Control.Applicative
 import Test.Hspec
 import Test.QuickCheck
-import Data.Torrent.Piece
+import Data.Torrent
 
 
 instance Arbitrary a => Arbitrary (Piece a) where
diff --git a/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs b/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
index 975ceb5b..5392d74b 100644
--- a/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
+++ b/tests/Network/BitTorrent/Exchange/Session/MetadataSpec.hs
@@ -7,8 +7,7 @@ import Test.Hspec
 import Test.QuickCheck
 
 import Data.BEncode as BE
-import Data.Torrent
-import Data.Torrent.Piece as P
+import Data.Torrent as Torrent
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Message
 import Network.BitTorrent.Exchange.Session.Metadata
@@ -36,7 +35,7 @@ simulateFetch :: InfoDict -> Updates (Maybe InfoDict)
 simulateFetch dict = go
   where
     blocks = chunkBy metadataPieceSize (BL.toStrict (BE.encode dict))
-    packPiece ix = P.Piece ix (blocks !! ix)
+    packPiece ix = Torrent.Piece ix (blocks !! ix)
     ih     = idInfoHash dict
 
     go = do
diff --git a/tests/System/Torrent/StorageSpec.hs b/tests/System/Torrent/StorageSpec.hs
index ebf4fe3e..96f1b036 100644
--- a/tests/System/Torrent/StorageSpec.hs
+++ b/tests/System/Torrent/StorageSpec.hs
@@ -7,9 +7,8 @@ import System.Directory
 import System.IO.Unsafe
 import Test.Hspec
 
-import Data.Torrent.Bitfield as BF
 import Data.Torrent
-import Data.Torrent.Piece
+import Data.Torrent.Bitfield as BF
 import System.Torrent.Storage
 
 
-- 
cgit v1.2.3


From 3867719780293528e604452818b9d9a616938783 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Tue, 8 Apr 2014 03:56:29 +0400
Subject: Move bitfield to exchange subsystem

---
 bittorrent.cabal                                  |   4 +-
 src/Data/Torrent/Bitfield.hs                      | 324 ----------------------
 src/Network/BitTorrent/Exchange/Bitfield.hs       | 324 ++++++++++++++++++++++
 src/Network/BitTorrent/Exchange/Connection.hs     |   4 +-
 src/Network/BitTorrent/Exchange/Message.hs        |   2 +-
 src/Network/BitTorrent/Exchange/Selection.hs      |   2 +-
 src/Network/BitTorrent/Exchange/Session.hs        |   2 +-
 src/Network/BitTorrent/Exchange/Session/Status.hs |   2 +-
 src/System/Torrent/Storage.hs                     |   2 +-
 tests/Data/Torrent/BitfieldSpec.hs                |  13 -
 tests/Network/BitTorrent/Exchange/BitfieldSpec.hs |  13 +
 tests/Network/BitTorrent/Exchange/MessageSpec.hs  |   2 +-
 tests/System/Torrent/StorageSpec.hs               |   2 +-
 13 files changed, 348 insertions(+), 348 deletions(-)
 delete mode 100644 src/Data/Torrent/Bitfield.hs
 create mode 100644 src/Network/BitTorrent/Exchange/Bitfield.hs
 delete mode 100644 tests/Data/Torrent/BitfieldSpec.hs
 create mode 100644 tests/Network/BitTorrent/Exchange/BitfieldSpec.hs

(limited to 'src/System/Torrent')

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 6df074bb..cd4c5d38 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -45,7 +45,6 @@ library
                      , RecordWildCards
   hs-source-dirs:      src
   exposed-modules:     Data.Torrent
-                       Data.Torrent.Bitfield
                        Data.Torrent.Progress
                        Data.Torrent.Tree
                        Network.BitTorrent
@@ -62,6 +61,7 @@ library
                        Network.BitTorrent.DHT.Token
                        Network.BitTorrent.Exchange
                        Network.BitTorrent.Exchange.Assembler
+                       Network.BitTorrent.Exchange.Bitfield
                        Network.BitTorrent.Exchange.Block
                        Network.BitTorrent.Exchange.Connection
                        Network.BitTorrent.Exchange.Manager
@@ -173,7 +173,6 @@ test-suite spec
                        Config
 
                        Data.TorrentSpec
-                       Data.Torrent.BitfieldSpec
                        Data.Torrent.ProgressSpec
                        Network.BitTorrent.Client.HandleSpec
                        Network.BitTorrent.CoreSpec
@@ -192,6 +191,7 @@ test-suite spec
                        Network.BitTorrent.Tracker.RPC.HTTPSpec
                        Network.BitTorrent.Tracker.RPC.UDPSpec
                        Network.BitTorrent.Tracker.SessionSpec
+                       Network.BitTorrent.Exchange.BitfieldSpec
                        Network.BitTorrent.Exchange.ConnectionSpec
                        Network.BitTorrent.Exchange.MessageSpec
                        Network.BitTorrent.Exchange.SessionSpec
diff --git a/src/Data/Torrent/Bitfield.hs b/src/Data/Torrent/Bitfield.hs
deleted file mode 100644
index ff701d75..00000000
--- a/src/Data/Torrent/Bitfield.hs
+++ /dev/null
@@ -1,324 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   This modules provides all necessary machinery to work with
---   bitfields. Bitfields are used to keep track indices of complete
---   pieces either peer have or client have.
---
---   There are also commonly used piece seletion algorithms
---   which used to find out which one next piece to download.
---   Selectors considered to be used in the following order:
---
---     * Random first - at the start.
---
---     * Rarest first selection - performed to avoid situation when
---     rarest piece is unaccessible.
---
---     * /End game/ seletion - performed after a peer has requested all
---     the subpieces of the content.
---
---   Note that BitTorrent applies the strict priority policy for
---   /subpiece/ or /blocks/ selection.
---
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
-module Data.Torrent.Bitfield
-       ( -- * Bitfield
-         PieceIx
-       , PieceCount
-       , Bitfield
-
-         -- * Construction
-       , haveAll
-       , haveNone
-       , have
-       , singleton
-       , interval
-       , adjustSize
-
-         -- * Query
-         -- ** Cardinality
-       , Data.Torrent.Bitfield.null
-       , Data.Torrent.Bitfield.full
-       , haveCount
-       , totalCount
-       , completeness
-
-         -- ** Membership
-       , member
-       , notMember
-       , findMin
-       , findMax
-       , isSubsetOf
-
-         -- ** Availability
-       , complement
-       , Frequency
-       , frequencies
-       , rarest
-
-         -- * Combine
-       , insert
-       , union
-       , intersection
-       , difference
-
-         -- * Conversion
-       , toList
-       , fromList
-
-         -- * Serialization
-       , fromBitmap
-       , toBitmap
-       ) where
-
-import Control.Monad
-import Control.Monad.ST
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as Lazy
-import           Data.Vector.Unboxed (Vector)
-import qualified Data.Vector.Unboxed as V
-import qualified Data.Vector.Unboxed.Mutable as VM
-import           Data.IntervalSet (IntSet)
-import qualified Data.IntervalSet as S
-import qualified Data.IntervalSet.ByteString as S
-import           Data.List (foldl')
-import           Data.Monoid
-import           Data.Ratio
-
-import Data.Torrent
-
--- TODO cache some operations
-
--- | Bitfields are represented just as integer sets but with
--- restriction: the each set should be within given interval (or
--- subset of the specified interval). Size is used to specify
--- interval, so bitfield of size 10 might contain only indices in
--- interval [0..9].
---
-data Bitfield = Bitfield {
-    bfSize :: !PieceCount
-  , bfSet  :: !IntSet
-  } deriving (Show, Read, Eq)
-
--- Invariants: all elements of bfSet lie in [0..bfSize - 1];
-
-instance Monoid Bitfield where
-  {-# SPECIALIZE instance Monoid Bitfield #-}
-  mempty  = haveNone 0
-  mappend = union
-  mconcat = unions
-
-{-----------------------------------------------------------------------
-    Construction
------------------------------------------------------------------------}
-
--- | The empty bitfield of the given size.
-haveNone :: PieceCount -> Bitfield
-haveNone s = Bitfield s S.empty
-
--- | The full bitfield containing all piece indices for the given size.
-haveAll :: PieceCount -> Bitfield
-haveAll s = Bitfield s (S.interval 0 (s - 1))
-
--- | Insert the index in the set ignoring out of range indices.
-have :: PieceIx -> Bitfield -> Bitfield
-have ix Bitfield {..}
-  | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
-  |      otherwise         = Bitfield bfSize bfSet
-
-singleton :: PieceIx -> PieceCount -> Bitfield
-singleton ix pc = have ix (haveNone pc)
-
--- | Assign new size to bitfield. FIXME Normally, size should be only
--- decreased, otherwise exception raised.
-adjustSize :: PieceCount -> Bitfield -> Bitfield
-adjustSize s Bitfield {..} = Bitfield s bfSet
-
--- | NOTE: for internal use only
-interval :: PieceCount -> PieceIx -> PieceIx -> Bitfield
-interval pc a b = Bitfield pc (S.interval a b)
-
-{-----------------------------------------------------------------------
-    Query
------------------------------------------------------------------------}
-
--- | Test if bitifield have no one index: peer do not have anything.
-null :: Bitfield -> Bool
-null Bitfield {..} = S.null bfSet
-
--- | Test if bitfield have all pieces.
-full :: Bitfield -> Bool
-full Bitfield {..} = S.size bfSet == bfSize
-
--- | Count of peer have pieces.
-haveCount :: Bitfield -> PieceCount
-haveCount = S.size . bfSet
-
--- | Total count of pieces and its indices.
-totalCount :: Bitfield -> PieceCount
-totalCount = bfSize
-
--- | Ratio of /have/ piece count to the /total/ piece count.
---
---   > forall bf. 0 <= completeness bf <= 1
---
-completeness :: Bitfield -> Ratio PieceCount
-completeness b = haveCount b % totalCount b
-
-inRange :: PieceIx -> Bitfield -> Bool
-inRange ix Bitfield {..} = 0 <= ix && ix < bfSize
-
-member :: PieceIx -> Bitfield -> Bool
-member ix bf @ Bitfield {..}
-  | ix `inRange` bf = ix `S.member` bfSet
-  |     otherwise   = False
-
-notMember :: PieceIx -> Bitfield -> Bool
-notMember ix bf @ Bitfield {..}
-  | ix `inRange` bf = ix `S.notMember` bfSet
-  |     otherwise   = True
-
--- | Find first available piece index.
-findMin :: Bitfield -> PieceIx
-findMin = S.findMin . bfSet
-{-# INLINE findMin #-}
-
--- | Find last available piece index.
-findMax :: Bitfield -> PieceIx
-findMax = S.findMax . bfSet
-{-# INLINE findMax #-}
-
--- | Check if all pieces from first bitfield present if the second bitfield
-isSubsetOf :: Bitfield -> Bitfield -> Bool
-isSubsetOf a b = bfSet a `S.isSubsetOf` bfSet b
-{-# INLINE isSubsetOf #-}
-
--- | Resulting bitfield includes only missing pieces.
-complement :: Bitfield -> Bitfield
-complement Bitfield {..} = Bitfield
-  { bfSet  = uni `S.difference` bfSet
-  , bfSize = bfSize
-  }
-  where
-    Bitfield _ uni = haveAll bfSize
-{-# INLINE complement #-}
-
-{-----------------------------------------------------------------------
--- Availability
------------------------------------------------------------------------}
-
--- | Frequencies are needed in piece selection startegies which use
--- availability quantity to find out the optimal next piece index to
--- download.
-type Frequency = Int
-
--- TODO rename to availability
--- | How many times each piece index occur in the given bitfield set.
-frequencies :: [Bitfield] -> Vector Frequency
-frequencies [] = V.fromList []
-frequencies xs = runST $ do
-    v <- VM.new size
-    VM.set v 0
-    forM_ xs $ \ Bitfield {..} -> do
-      forM_ (S.toList bfSet) $ \ x -> do
-        fr <- VM.read v x
-        VM.write v x (succ fr)
-    V.unsafeFreeze v
-  where
-    size = maximum (map bfSize xs)
-
--- TODO it seems like this operation is veeery slow
-
--- | Find least available piece index. If no piece available return
--- 'Nothing'.
-rarest :: [Bitfield] -> Maybe PieceIx
-rarest xs
-    | V.null freqMap = Nothing
-    |     otherwise
-    = Just $ fst $ V.ifoldr' minIx (0, freqMap V.! 0) freqMap
-  where
-    freqMap = frequencies xs
-
-    minIx ::  PieceIx -> Frequency
-          -> (PieceIx,   Frequency)
-          -> (PieceIx,   Frequency)
-    minIx ix fr acc@(_, fra)
-      | fr < fra && fr > 0 = (ix, fr)
-      |     otherwise      = acc
-
-
-{-----------------------------------------------------------------------
-    Combine
------------------------------------------------------------------------}
-
-insert :: PieceIx -> Bitfield -> Bitfield
-insert pix bf @ Bitfield {..}
-  | 0 <= pix && pix < bfSize = Bitfield
-    { bfSet  = S.insert pix bfSet
-    , bfSize = bfSize
-    }
-  | otherwise = bf
-
--- | Find indices at least one peer have.
-union :: Bitfield -> Bitfield -> Bitfield
-union a b = {-# SCC union #-} Bitfield {
-    bfSize = bfSize a `max` bfSize b
-  , bfSet  = bfSet a `S.union` bfSet b
-  }
-
--- | Find indices both peers have.
-intersection :: Bitfield -> Bitfield -> Bitfield
-intersection a b = {-# SCC intersection #-} Bitfield {
-    bfSize = bfSize a `min` bfSize b
-  , bfSet  = bfSet a `S.intersection` bfSet b
-  }
-
--- | Find indices which have first peer but do not have the second peer.
-difference :: Bitfield -> Bitfield -> Bitfield
-difference a b = {-# SCC difference #-} Bitfield {
-    bfSize = bfSize a -- FIXME is it reasonable?
-  , bfSet  = bfSet a `S.difference` bfSet b
-  }
-
--- | Find indices the any of the peers have.
-unions :: [Bitfield] -> Bitfield
-unions = {-# SCC unions #-} foldl' union (haveNone 0)
-
-{-----------------------------------------------------------------------
-    Serialization
------------------------------------------------------------------------}
-
--- | List all /have/ indexes.
-toList :: Bitfield -> [PieceIx]
-toList Bitfield {..} = S.toList bfSet
-
--- | Make bitfield from list of /have/ indexes.
-fromList :: PieceCount -> [PieceIx] -> Bitfield
-fromList s ixs = Bitfield {
-    bfSize = s
-  , bfSet  = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
-  }
-
--- | Unpack 'Bitfield' from tightly packed bit array. Note resulting
--- size might be more than real bitfield size, use 'adjustSize'.
-fromBitmap :: ByteString -> Bitfield
-fromBitmap bs = {-# SCC fromBitmap #-} Bitfield {
-    bfSize = B.length bs * 8
-  , bfSet  = S.fromByteString bs
-  }
-{-# INLINE fromBitmap #-}
-
--- | Pack a 'Bitfield' to tightly packed bit array.
-toBitmap :: Bitfield -> Lazy.ByteString
-toBitmap Bitfield {..} = {-# SCC toBitmap #-} Lazy.fromChunks [intsetBM, alignment]
-  where
-    byteSize  = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1
-    alignment = B.replicate (byteSize - B.length intsetBM) 0
-    intsetBM  = S.toByteString bfSet
diff --git a/src/Network/BitTorrent/Exchange/Bitfield.hs b/src/Network/BitTorrent/Exchange/Bitfield.hs
new file mode 100644
index 00000000..3f4931f3
--- /dev/null
+++ b/src/Network/BitTorrent/Exchange/Bitfield.hs
@@ -0,0 +1,324 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   This modules provides all necessary machinery to work with
+--   bitfields. Bitfields are used to keep track indices of complete
+--   pieces either peer have or client have.
+--
+--   There are also commonly used piece seletion algorithms
+--   which used to find out which one next piece to download.
+--   Selectors considered to be used in the following order:
+--
+--     * Random first - at the start.
+--
+--     * Rarest first selection - performed to avoid situation when
+--     rarest piece is unaccessible.
+--
+--     * /End game/ seletion - performed after a peer has requested all
+--     the subpieces of the content.
+--
+--   Note that BitTorrent applies the strict priority policy for
+--   /subpiece/ or /blocks/ selection.
+--
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Exchange.Bitfield
+       ( -- * Bitfield
+         PieceIx
+       , PieceCount
+       , Bitfield
+
+         -- * Construction
+       , haveAll
+       , haveNone
+       , have
+       , singleton
+       , interval
+       , adjustSize
+
+         -- * Query
+         -- ** Cardinality
+       , Network.BitTorrent.Exchange.Bitfield.null
+       , Network.BitTorrent.Exchange.Bitfield.full
+       , haveCount
+       , totalCount
+       , completeness
+
+         -- ** Membership
+       , member
+       , notMember
+       , findMin
+       , findMax
+       , isSubsetOf
+
+         -- ** Availability
+       , complement
+       , Frequency
+       , frequencies
+       , rarest
+
+         -- * Combine
+       , insert
+       , union
+       , intersection
+       , difference
+
+         -- * Conversion
+       , toList
+       , fromList
+
+         -- * Serialization
+       , fromBitmap
+       , toBitmap
+       ) where
+
+import Control.Monad
+import Control.Monad.ST
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as Lazy
+import           Data.Vector.Unboxed (Vector)
+import qualified Data.Vector.Unboxed as V
+import qualified Data.Vector.Unboxed.Mutable as VM
+import           Data.IntervalSet (IntSet)
+import qualified Data.IntervalSet as S
+import qualified Data.IntervalSet.ByteString as S
+import           Data.List (foldl')
+import           Data.Monoid
+import           Data.Ratio
+
+import Data.Torrent
+
+-- TODO cache some operations
+
+-- | Bitfields are represented just as integer sets but with
+-- restriction: the each set should be within given interval (or
+-- subset of the specified interval). Size is used to specify
+-- interval, so bitfield of size 10 might contain only indices in
+-- interval [0..9].
+--
+data Bitfield = Bitfield {
+    bfSize :: !PieceCount
+  , bfSet  :: !IntSet
+  } deriving (Show, Read, Eq)
+
+-- Invariants: all elements of bfSet lie in [0..bfSize - 1];
+
+instance Monoid Bitfield where
+  {-# SPECIALIZE instance Monoid Bitfield #-}
+  mempty  = haveNone 0
+  mappend = union
+  mconcat = unions
+
+{-----------------------------------------------------------------------
+    Construction
+-----------------------------------------------------------------------}
+
+-- | The empty bitfield of the given size.
+haveNone :: PieceCount -> Bitfield
+haveNone s = Bitfield s S.empty
+
+-- | The full bitfield containing all piece indices for the given size.
+haveAll :: PieceCount -> Bitfield
+haveAll s = Bitfield s (S.interval 0 (s - 1))
+
+-- | Insert the index in the set ignoring out of range indices.
+have :: PieceIx -> Bitfield -> Bitfield
+have ix Bitfield {..}
+  | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
+  |      otherwise         = Bitfield bfSize bfSet
+
+singleton :: PieceIx -> PieceCount -> Bitfield
+singleton ix pc = have ix (haveNone pc)
+
+-- | Assign new size to bitfield. FIXME Normally, size should be only
+-- decreased, otherwise exception raised.
+adjustSize :: PieceCount -> Bitfield -> Bitfield
+adjustSize s Bitfield {..} = Bitfield s bfSet
+
+-- | NOTE: for internal use only
+interval :: PieceCount -> PieceIx -> PieceIx -> Bitfield
+interval pc a b = Bitfield pc (S.interval a b)
+
+{-----------------------------------------------------------------------
+    Query
+-----------------------------------------------------------------------}
+
+-- | Test if bitifield have no one index: peer do not have anything.
+null :: Bitfield -> Bool
+null Bitfield {..} = S.null bfSet
+
+-- | Test if bitfield have all pieces.
+full :: Bitfield -> Bool
+full Bitfield {..} = S.size bfSet == bfSize
+
+-- | Count of peer have pieces.
+haveCount :: Bitfield -> PieceCount
+haveCount = S.size . bfSet
+
+-- | Total count of pieces and its indices.
+totalCount :: Bitfield -> PieceCount
+totalCount = bfSize
+
+-- | Ratio of /have/ piece count to the /total/ piece count.
+--
+--   > forall bf. 0 <= completeness bf <= 1
+--
+completeness :: Bitfield -> Ratio PieceCount
+completeness b = haveCount b % totalCount b
+
+inRange :: PieceIx -> Bitfield -> Bool
+inRange ix Bitfield {..} = 0 <= ix && ix < bfSize
+
+member :: PieceIx -> Bitfield -> Bool
+member ix bf @ Bitfield {..}
+  | ix `inRange` bf = ix `S.member` bfSet
+  |     otherwise   = False
+
+notMember :: PieceIx -> Bitfield -> Bool
+notMember ix bf @ Bitfield {..}
+  | ix `inRange` bf = ix `S.notMember` bfSet
+  |     otherwise   = True
+
+-- | Find first available piece index.
+findMin :: Bitfield -> PieceIx
+findMin = S.findMin . bfSet
+{-# INLINE findMin #-}
+
+-- | Find last available piece index.
+findMax :: Bitfield -> PieceIx
+findMax = S.findMax . bfSet
+{-# INLINE findMax #-}
+
+-- | Check if all pieces from first bitfield present if the second bitfield
+isSubsetOf :: Bitfield -> Bitfield -> Bool
+isSubsetOf a b = bfSet a `S.isSubsetOf` bfSet b
+{-# INLINE isSubsetOf #-}
+
+-- | Resulting bitfield includes only missing pieces.
+complement :: Bitfield -> Bitfield
+complement Bitfield {..} = Bitfield
+  { bfSet  = uni `S.difference` bfSet
+  , bfSize = bfSize
+  }
+  where
+    Bitfield _ uni = haveAll bfSize
+{-# INLINE complement #-}
+
+{-----------------------------------------------------------------------
+-- Availability
+-----------------------------------------------------------------------}
+
+-- | Frequencies are needed in piece selection startegies which use
+-- availability quantity to find out the optimal next piece index to
+-- download.
+type Frequency = Int
+
+-- TODO rename to availability
+-- | How many times each piece index occur in the given bitfield set.
+frequencies :: [Bitfield] -> Vector Frequency
+frequencies [] = V.fromList []
+frequencies xs = runST $ do
+    v <- VM.new size
+    VM.set v 0
+    forM_ xs $ \ Bitfield {..} -> do
+      forM_ (S.toList bfSet) $ \ x -> do
+        fr <- VM.read v x
+        VM.write v x (succ fr)
+    V.unsafeFreeze v
+  where
+    size = maximum (map bfSize xs)
+
+-- TODO it seems like this operation is veeery slow
+
+-- | Find least available piece index. If no piece available return
+-- 'Nothing'.
+rarest :: [Bitfield] -> Maybe PieceIx
+rarest xs
+    | V.null freqMap = Nothing
+    |     otherwise
+    = Just $ fst $ V.ifoldr' minIx (0, freqMap V.! 0) freqMap
+  where
+    freqMap = frequencies xs
+
+    minIx ::  PieceIx -> Frequency
+          -> (PieceIx,   Frequency)
+          -> (PieceIx,   Frequency)
+    minIx ix fr acc@(_, fra)
+      | fr < fra && fr > 0 = (ix, fr)
+      |     otherwise      = acc
+
+
+{-----------------------------------------------------------------------
+    Combine
+-----------------------------------------------------------------------}
+
+insert :: PieceIx -> Bitfield -> Bitfield
+insert pix bf @ Bitfield {..}
+  | 0 <= pix && pix < bfSize = Bitfield
+    { bfSet  = S.insert pix bfSet
+    , bfSize = bfSize
+    }
+  | otherwise = bf
+
+-- | Find indices at least one peer have.
+union :: Bitfield -> Bitfield -> Bitfield
+union a b = {-# SCC union #-} Bitfield {
+    bfSize = bfSize a `max` bfSize b
+  , bfSet  = bfSet a `S.union` bfSet b
+  }
+
+-- | Find indices both peers have.
+intersection :: Bitfield -> Bitfield -> Bitfield
+intersection a b = {-# SCC intersection #-} Bitfield {
+    bfSize = bfSize a `min` bfSize b
+  , bfSet  = bfSet a `S.intersection` bfSet b
+  }
+
+-- | Find indices which have first peer but do not have the second peer.
+difference :: Bitfield -> Bitfield -> Bitfield
+difference a b = {-# SCC difference #-} Bitfield {
+    bfSize = bfSize a -- FIXME is it reasonable?
+  , bfSet  = bfSet a `S.difference` bfSet b
+  }
+
+-- | Find indices the any of the peers have.
+unions :: [Bitfield] -> Bitfield
+unions = {-# SCC unions #-} foldl' union (haveNone 0)
+
+{-----------------------------------------------------------------------
+    Serialization
+-----------------------------------------------------------------------}
+
+-- | List all /have/ indexes.
+toList :: Bitfield -> [PieceIx]
+toList Bitfield {..} = S.toList bfSet
+
+-- | Make bitfield from list of /have/ indexes.
+fromList :: PieceCount -> [PieceIx] -> Bitfield
+fromList s ixs = Bitfield {
+    bfSize = s
+  , bfSet  = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
+  }
+
+-- | Unpack 'Bitfield' from tightly packed bit array. Note resulting
+-- size might be more than real bitfield size, use 'adjustSize'.
+fromBitmap :: ByteString -> Bitfield
+fromBitmap bs = {-# SCC fromBitmap #-} Bitfield {
+    bfSize = B.length bs * 8
+  , bfSet  = S.fromByteString bs
+  }
+{-# INLINE fromBitmap #-}
+
+-- | Pack a 'Bitfield' to tightly packed bit array.
+toBitmap :: Bitfield -> Lazy.ByteString
+toBitmap Bitfield {..} = {-# SCC toBitmap #-} Lazy.fromChunks [intsetBM, alignment]
+  where
+    byteSize  = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1
+    alignment = B.replicate (byteSize - B.length intsetBM) 0
+    intsetBM  = S.toByteString bfSet
diff --git a/src/Network/BitTorrent/Exchange/Connection.hs b/src/Network/BitTorrent/Exchange/Connection.hs
index 9b7942ae..f208fa54 100644
--- a/src/Network/BitTorrent/Exchange/Connection.hs
+++ b/src/Network/BitTorrent/Exchange/Connection.hs
@@ -135,10 +135,10 @@ import Text.Show.Functions ()
 import System.Log.FastLogger (ToLogStr(..))
 import System.Timeout
 
-import Data.Torrent.Bitfield as BF
 import Data.Torrent
 import Network.BitTorrent.Address
-import Network.BitTorrent.Exchange.Message as Msg
+import Network.BitTorrent.Exchange.Bitfield as BF
+import Network.BitTorrent.Exchange.Message  as Msg
 
 -- TODO handle port message?
 -- TODO handle limits?
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index a0cb5c91..f8b76186 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -117,10 +117,10 @@ import Network.Socket hiding (KeepAlive)
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.Bitfield
 import Data.Torrent hiding (Piece (..))
 import qualified Data.Torrent as P (Piece (..))
 import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield
 import Network.BitTorrent.Exchange.Block
 
 {-----------------------------------------------------------------------
diff --git a/src/Network/BitTorrent/Exchange/Selection.hs b/src/Network/BitTorrent/Exchange/Selection.hs
index 2724fabc..3701450b 100644
--- a/src/Network/BitTorrent/Exchange/Selection.hs
+++ b/src/Network/BitTorrent/Exchange/Selection.hs
@@ -22,7 +22,7 @@ module Network.BitTorrent.Exchange.Selection
 
 import Data.Ratio
 
-import Data.Torrent.Bitfield
+import Network.BitTorrent.Exchange.Bitfield
 
 
 type Selector =  Bitfield      -- ^ Indices of client /have/ pieces.
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index b68f17a0..4c6811d9 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -46,9 +46,9 @@ import System.Log.FastLogger (LogStr, ToLogStr (..))
 
 import Data.BEncode as BE
 import Data.Torrent as Torrent
-import Data.Torrent.Bitfield as BF
 import Network.BitTorrent.Internal.Types
 import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield as BF
 import Network.BitTorrent.Exchange.Block   as Block
 import Network.BitTorrent.Exchange.Connection
 import Network.BitTorrent.Exchange.Message as Message
diff --git a/src/Network/BitTorrent/Exchange/Session/Status.hs b/src/Network/BitTorrent/Exchange/Session/Status.hs
index 63b91926..af3e94f5 100644
--- a/src/Network/BitTorrent/Exchange/Session/Status.hs
+++ b/src/Network/BitTorrent/Exchange/Session/Status.hs
@@ -29,7 +29,7 @@ import Data.Set as S
 import Data.Tuple
 
 import Data.Torrent
-import Data.Torrent.Bitfield as BF
+import Network.BitTorrent.Exchange.Bitfield as BF
 import Network.BitTorrent.Address
 import Network.BitTorrent.Exchange.Block as Block
 import System.Torrent.Storage (Storage, writePiece)
diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs
index 1123cea9..1d77e55d 100644
--- a/src/System/Torrent/Storage.hs
+++ b/src/System/Torrent/Storage.hs
@@ -56,7 +56,7 @@ import Data.Conduit.List as C
 import Data.Typeable
 
 import Data.Torrent
-import Data.Torrent.Bitfield as BF
+import Network.BitTorrent.Exchange.Bitfield as BF
 import System.Torrent.FileMap as FM
 
 
diff --git a/tests/Data/Torrent/BitfieldSpec.hs b/tests/Data/Torrent/BitfieldSpec.hs
deleted file mode 100644
index 093f6f19..00000000
--- a/tests/Data/Torrent/BitfieldSpec.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# OPTIONS -fno-warn-orphans #-}
-module Data.Torrent.BitfieldSpec (spec) where
-import Control.Applicative
-import Test.Hspec
-import Test.QuickCheck
-
-import Data.Torrent.Bitfield
-
-instance Arbitrary Bitfield where
-  arbitrary = fromBitmap <$> arbitrary
-
-spec :: Spec
-spec = return ()
\ No newline at end of file
diff --git a/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs b/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs
new file mode 100644
index 00000000..234965fa
--- /dev/null
+++ b/tests/Network/BitTorrent/Exchange/BitfieldSpec.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS -fno-warn-orphans #-}
+module Network.BitTorrent.Exchange.BitfieldSpec (spec) where
+import Control.Applicative
+import Test.Hspec
+import Test.QuickCheck
+
+import Network.BitTorrent.Exchange.Bitfield
+
+instance Arbitrary Bitfield where
+  arbitrary = fromBitmap <$> arbitrary
+
+spec :: Spec
+spec = return ()
\ No newline at end of file
diff --git a/tests/Network/BitTorrent/Exchange/MessageSpec.hs b/tests/Network/BitTorrent/Exchange/MessageSpec.hs
index f82b034e..d615b1ff 100644
--- a/tests/Network/BitTorrent/Exchange/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Exchange/MessageSpec.hs
@@ -11,7 +11,7 @@ import Test.Hspec
 import Test.QuickCheck
 
 import Data.TorrentSpec ()
-import Data.Torrent.BitfieldSpec ()
+import Network.BitTorrent.Exchange.BitfieldSpec ()
 import Network.BitTorrent.CoreSpec ()
 import Network.BitTorrent.Address ()
 import Network.BitTorrent.Exchange.BlockSpec ()
diff --git a/tests/System/Torrent/StorageSpec.hs b/tests/System/Torrent/StorageSpec.hs
index 96f1b036..b5e49078 100644
--- a/tests/System/Torrent/StorageSpec.hs
+++ b/tests/System/Torrent/StorageSpec.hs
@@ -8,7 +8,7 @@ import System.IO.Unsafe
 import Test.Hspec
 
 import Data.Torrent
-import Data.Torrent.Bitfield as BF
+import Network.BitTorrent.Exchange.Bitfield as BF
 import System.Torrent.Storage
 
 
-- 
cgit v1.2.3


From 11fca56c179ce2da7d279293a6b3c7d1bb35c74c Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Tue, 8 Apr 2014 04:53:22 +0400
Subject: Hide Tree.hs module

---
 bittorrent.cabal           |  3 +-
 src/Data/Torrent/Tree.hs   | 83 ----------------------------------------------
 src/System/Torrent/Tree.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 85 insertions(+), 84 deletions(-)
 delete mode 100644 src/Data/Torrent/Tree.hs
 create mode 100644 src/System/Torrent/Tree.hs

(limited to 'src/System/Torrent')

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 292680dd..0ceec550 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -50,7 +50,6 @@ library
   hs-source-dirs:      src
   exposed-modules:     Data.Torrent
                        Data.Torrent.Progress
-                       Data.Torrent.Tree
                        Network.BitTorrent
                        Network.BitTorrent.Address
                        Network.BitTorrent.Client
@@ -87,11 +86,13 @@ library
                        Network.BitTorrent.Internal.Cache
                        Network.BitTorrent.Internal.Types
                        System.Torrent.FileMap
+                       System.Torrent.Tree
   else
     other-modules:
                        Network.BitTorrent.Internal.Cache
                        Network.BitTorrent.Internal.Types
                        System.Torrent.FileMap
+                       System.Torrent.Tree
 
   build-depends:       base       == 4.*
                      , lifted-base
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs
deleted file mode 100644
index 5825422f..00000000
--- a/src/Data/Torrent/Tree.hs
+++ /dev/null
@@ -1,83 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Directory tree can be used to easily manipulate file layout info.
---
-{-# LANGUAGE FlexibleInstances  #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module Data.Torrent.Tree
-       ( -- * Directory tree
-         DirTree (..)
-
-         -- * Construction
-       , build
-
-         -- * Query
-       , Data.Torrent.Tree.lookup
-       , lookupDir
-       , fileNumber
-       , dirNumber
-       ) where
-
-import Data.ByteString as BS
-import Data.ByteString.Char8 as BC
-import Data.Foldable
-import Data.List as L
-import Data.Map  as M
-import Data.Monoid
-
-import Data.Torrent
-
-
--- | 'DirTree' is more convenient form of 'LayoutInfo'.
-data DirTree a = Dir  { children :: Map ByteString (DirTree a) }
-               | File { node     :: FileInfo a                 }
-                 deriving Show
-
--- | Build directory tree from a list of files.
-build :: LayoutInfo -> DirTree ()
-build SingleFile {liFile = FileInfo {..}} = Dir
-    { children = M.singleton fiName (File fi) }
-  where
-    fi = FileInfo fiLength fiMD5Sum ()
-build MultiFile {..} = Dir $ M.singleton liDirName files
-  where
-    files = Dir $ M.fromList $ L.map mkFileEntry liFiles
-    mkFileEntry FileInfo {..} = (L.head fiName, ent) -- TODO FIXME
-      where
-        ent = File $ FileInfo fiLength fiMD5Sum ()
-
---decompress :: DirTree () -> [FileInfo ()]
---decompress = undefined
-
--- TODO pretty print
-
--- | Lookup file by path.
-lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
-lookup []        t      = Just t
-lookup (p : ps) (Dir m) | Just subTree <- M.lookup (BC.pack p) m
-                        = Data.Torrent.Tree.lookup ps subTree
-lookup _         _      = Nothing
-
--- | Lookup directory by path.
-lookupDir :: [FilePath] -> DirTree a -> Maybe [(ByteString, DirTree a)]
-lookupDir ps d = do
-  subTree <- Data.Torrent.Tree.lookup ps d
-  case subTree of
-    File _  -> Nothing
-    Dir  es -> Just $ M.toList es
-
--- | Get total count of files in directory and subdirectories.
-fileNumber :: DirTree a -> Sum Int
-fileNumber File {..} = Sum 1
-fileNumber Dir  {..} = foldMap fileNumber children
-
--- | Get total count of directories in the directory and subdirectories.
-dirNumber :: DirTree a -> Sum Int
-dirNumber File {..} = Sum 0
-dirNumber Dir  {..} = Sum 1 <> foldMap dirNumber children
diff --git a/src/System/Torrent/Tree.hs b/src/System/Torrent/Tree.hs
new file mode 100644
index 00000000..41cfb360
--- /dev/null
+++ b/src/System/Torrent/Tree.hs
@@ -0,0 +1,83 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   Directory tree can be used to easily manipulate file layout info.
+--
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module System.Torrent.Tree
+       ( -- * Directory tree
+         DirTree (..)
+
+         -- * Construction
+       , build
+
+         -- * Query
+       , System.Torrent.Tree.lookup
+       , lookupDir
+       , fileNumber
+       , dirNumber
+       ) where
+
+import Data.ByteString as BS
+import Data.ByteString.Char8 as BC
+import Data.Foldable
+import Data.List as L
+import Data.Map  as M
+import Data.Monoid
+
+import Data.Torrent
+
+
+-- | 'DirTree' is more convenient form of 'LayoutInfo'.
+data DirTree a = Dir  { children :: Map ByteString (DirTree a) }
+               | File { node     :: FileInfo a                 }
+                 deriving Show
+
+-- | Build directory tree from a list of files.
+build :: LayoutInfo -> DirTree ()
+build SingleFile {liFile = FileInfo {..}} = Dir
+    { children = M.singleton fiName (File fi) }
+  where
+    fi = FileInfo fiLength fiMD5Sum ()
+build MultiFile {..} = Dir $ M.singleton liDirName files
+  where
+    files = Dir $ M.fromList $ L.map mkFileEntry liFiles
+    mkFileEntry FileInfo {..} = (L.head fiName, ent) -- TODO FIXME
+      where
+        ent = File $ FileInfo fiLength fiMD5Sum ()
+
+--decompress :: DirTree () -> [FileInfo ()]
+--decompress = undefined
+
+-- TODO pretty print
+
+-- | Lookup file by path.
+lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
+lookup []        t      = Just t
+lookup (p : ps) (Dir m) | Just subTree <- M.lookup (BC.pack p) m
+                        = System.Torrent.Tree.lookup ps subTree
+lookup _         _      = Nothing
+
+-- | Lookup directory by path.
+lookupDir :: [FilePath] -> DirTree a -> Maybe [(ByteString, DirTree a)]
+lookupDir ps d = do
+  subTree <- System.Torrent.Tree.lookup ps d
+  case subTree of
+    File _  -> Nothing
+    Dir  es -> Just $ M.toList es
+
+-- | Get total count of files in directory and subdirectories.
+fileNumber :: DirTree a -> Sum Int
+fileNumber File {..} = Sum 1
+fileNumber Dir  {..} = foldMap fileNumber children
+
+-- | Get total count of directories in the directory and subdirectories.
+dirNumber :: DirTree a -> Sum Int
+dirNumber File {..} = Sum 0
+dirNumber Dir  {..} = Sum 1 <> foldMap dirNumber children
-- 
cgit v1.2.3