summaryrefslogtreecommitdiff
path: root/src/Data/Torrent/Block.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Torrent/Block.hs')
-rw-r--r--src/Data/Torrent/Block.hs53
1 files changed, 37 insertions, 16 deletions
diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs
index fa6fe8bd..e0507aed 100644
--- a/src/Data/Torrent/Block.hs
+++ b/src/Data/Torrent/Block.hs
@@ -1,9 +1,18 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- TODO
9--
1{-# LANGUAGE TemplateHaskell #-} 10{-# LANGUAGE TemplateHaskell #-}
2module Data.Torrent.Block 11module Data.Torrent.Block
3 ( -- * Block attribytes 12 ( -- * Block attributes
4 BlockLIx 13 BlockLIx
5 , PieceLIx 14 , PieceLIx
6 , defaultBlockSize -- TODO use data-default 15 , BlockSize (..)
7 16
8 -- * Block index 17 -- * Block index
9 , BlockIx(..) 18 , BlockIx(..)
@@ -22,9 +31,11 @@ module Data.Torrent.Block
22 31
23import Control.Applicative 32import Control.Applicative
24 33
34import Data.Aeson (ToJSON, FromJSON)
25import Data.Aeson.TH 35import Data.Aeson.TH
26import qualified Data.ByteString.Lazy as Lazy 36import qualified Data.ByteString.Lazy as Lazy
27import Data.Char 37import Data.Char
38import Data.Default
28import Data.List as L 39import Data.List as L
29 40
30import Data.Binary as B 41import Data.Binary as B
@@ -35,17 +46,23 @@ import Data.Serialize as S
35import Text.PrettyPrint 46import Text.PrettyPrint
36 47
37 48
38-- | Widely used semi-official block size.
39defaultBlockSize :: Int
40defaultBlockSize = 16 * 1024
41
42{----------------------------------------------------------------------- 49{-----------------------------------------------------------------------
43 Block Index 50-- Block attributes
44-----------------------------------------------------------------------} 51-----------------------------------------------------------------------}
45 52
53newtype BlockSize = BlockSize { unBlockSize :: Int }
54 deriving (Show, Eq, Num, ToJSON, FromJSON)
55
56-- | Widely used semi-official block size.
57instance Default BlockSize where
58 def = 16 * 1024
59
46type BlockLIx = Int 60type BlockLIx = Int
47type PieceLIx = Int 61type PieceLIx = Int
48 62
63{-----------------------------------------------------------------------
64 Block Index
65-----------------------------------------------------------------------}
49 66
50data BlockIx = BlockIx { 67data BlockIx = BlockIx {
51 -- | Zero-based piece index. 68 -- | Zero-based piece index.
@@ -55,7 +72,7 @@ data BlockIx = BlockIx {
55 , ixOffset :: {-# UNPACK #-} !Int 72 , ixOffset :: {-# UNPACK #-} !Int
56 73
57 -- | Block size starting from offset. 74 -- | Block size starting from offset.
58 , ixLength :: {-# UNPACK #-} !Int 75 , ixLength :: {-# UNPACK #-} !BlockSize
59 } deriving (Show, Eq) 76 } deriving (Show, Eq)
60 77
61$(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx) 78$(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx)
@@ -78,31 +95,35 @@ putIntB = B.putWord32be . fromIntegral
78 95
79instance Serialize BlockIx where 96instance Serialize BlockIx where
80 {-# SPECIALIZE instance Serialize BlockIx #-} 97 {-# SPECIALIZE instance Serialize BlockIx #-}
81 get = BlockIx <$> getInt <*> getInt <*> getInt 98 get = BlockIx <$> getInt
99 <*> getInt
100 <*> (BlockSize <$> getInt)
82 {-# INLINE get #-} 101 {-# INLINE get #-}
83 102
84 put BlockIx {..} = do 103 put BlockIx {..} = do
85 putInt ixPiece 104 putInt ixPiece
86 putInt ixOffset 105 putInt ixOffset
87 putInt ixLength 106 putInt (unBlockSize ixLength)
88 {-# INLINE put #-} 107 {-# INLINE put #-}
89 108
90instance Binary BlockIx where 109instance Binary BlockIx where
91 {-# SPECIALIZE instance Binary BlockIx #-} 110 {-# SPECIALIZE instance Binary BlockIx #-}
92 get = BlockIx <$> getIntB <*> getIntB <*> getIntB 111 get = BlockIx <$> getIntB
112 <*> getIntB
113 <*> (BlockSize <$> getIntB)
93 {-# INLINE get #-} 114 {-# INLINE get #-}
94 115
95 put BlockIx {..} = do 116 put BlockIx {..} = do
96 putIntB ixPiece 117 putIntB ixPiece
97 putIntB ixOffset 118 putIntB ixOffset
98 putIntB ixLength 119 putIntB (unBlockSize ixLength)
99 120
100-- | Format block index in human readable form. 121-- | Format block index in human readable form.
101ppBlockIx :: BlockIx -> Doc 122ppBlockIx :: BlockIx -> Doc
102ppBlockIx BlockIx {..} = 123ppBlockIx BlockIx {..} =
103 "piece = " <> int ixPiece <> "," <+> 124 "piece = " <> int ixPiece <> "," <+>
104 "offset = " <> int ixOffset <> "," <+> 125 "offset = " <> int ixOffset <> "," <+>
105 "length = " <> int ixLength 126 "length = " <> int (unBlockSize ixLength)
106 127
107{----------------------------------------------------------------------- 128{-----------------------------------------------------------------------
108 Block 129 Block
@@ -124,7 +145,7 @@ ppBlock :: Block Lazy.ByteString -> Doc
124ppBlock = ppBlockIx . blockIx 145ppBlock = ppBlockIx . blockIx
125{-# INLINE ppBlock #-} 146{-# INLINE ppBlock #-}
126 147
127blockSize :: Block Lazy.ByteString -> Int 148blockSize :: Block Lazy.ByteString -> BlockSize
128blockSize blk = fromIntegral (Lazy.length (blkData blk)) 149blockSize blk = fromIntegral (Lazy.length (blkData blk))
129{-# INLINE blockSize #-} 150{-# INLINE blockSize #-}
130 151
@@ -136,7 +157,7 @@ isPiece pieceSize (Block i offset bs) =
136{-# INLINE isPiece #-} 157{-# INLINE isPiece #-}
137 158
138pieceIx :: Int -> Int -> BlockIx 159pieceIx :: Int -> Int -> BlockIx
139pieceIx i = BlockIx i 0 160pieceIx i = BlockIx i 0 . BlockSize
140{-# INLINE pieceIx #-} 161{-# INLINE pieceIx #-}
141 162
142blockIx :: Block Lazy.ByteString -> BlockIx 163blockIx :: Block Lazy.ByteString -> BlockIx
@@ -155,5 +176,5 @@ ixRange pieceSize i = (offset, offset + len)
155 where 176 where
156 offset = fromIntegral pieceSize * fromIntegral (ixPiece i) 177 offset = fromIntegral pieceSize * fromIntegral (ixPiece i)
157 + fromIntegral (ixOffset i) 178 + fromIntegral (ixOffset i)
158 len = fromIntegral (ixLength i) 179 len = fromIntegral (unBlockSize (ixLength i))
159{-# INLINE ixRange #-} 180{-# INLINE ixRange #-}