summaryrefslogtreecommitdiff
path: root/src/Data/Torrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Torrent')
-rw-r--r--src/Data/Torrent/InfoHash.hs115
-rw-r--r--src/Data/Torrent/Layout.hs273
-rw-r--r--src/Data/Torrent/Magnet.hs236
-rw-r--r--src/Data/Torrent/Piece.hs203
-rw-r--r--src/Data/Torrent/Tree.hs71
5 files changed, 898 insertions, 0 deletions
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
new file mode 100644
index 00000000..71ea0260
--- /dev/null
+++ b/src/Data/Torrent/InfoHash.hs
@@ -0,0 +1,115 @@
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3module Data.Torrent.InfoHash
4 ( -- * Info hash
5 InfoHash(..)
6 , addHashToURI
7 , ppInfoHash
8
9
10 , Data.Torrent.InfoHash.hash
11 , Data.Torrent.InfoHash.hashlazy
12 ) where
13
14import Control.Applicative
15import Control.Monad
16import qualified Crypto.Hash.SHA1 as C
17import Data.Aeson
18import Data.BEncode
19import Data.ByteString as BS
20import Data.ByteString.Char8 as BC
21import Data.ByteString.Lazy as BL
22import Data.ByteString.Base16 as Base16
23import qualified Data.ByteString.Lazy.Builder as B
24import qualified Data.ByteString.Lazy.Builder.ASCII as B
25import Data.Char
26import Data.List as L
27import Data.Hashable as Hashable
28import Data.URLEncoded as URL
29import Data.Serialize
30import Data.String
31import Network.URI
32import Numeric
33import Text.ParserCombinators.ReadP as P
34import Text.PrettyPrint
35
36
37-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
38newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
39 deriving (Eq, Ord, ToJSON, FromJSON)
40
41-- | for hex encoded strings
42instance Show InfoHash where
43 show = render . ppInfoHash
44
45-- | for hex encoded strings
46instance Read InfoHash where
47 readsPrec _ = readP_to_S $ do
48 str <- replicateM 40 (satisfy isHexDigit)
49 return $ InfoHash $ decodeIH str
50 where
51 decodeIH = BS.pack . L.map fromHex . pair
52 fromHex (a, b) = read $ '0' : 'x' : a : b : []
53
54 pair (a : b : xs) = (a, b) : pair xs
55 pair _ = []
56
57-- | for base16 (hex) encoded strings
58instance IsString InfoHash where
59 fromString str
60 | L.length str == 40
61 , (ihStr, inv) <- Base16.decode $ BC.pack str
62 = if BS.length inv == 0 then InfoHash ihStr
63 else error "fromString: invalid infohash string"
64 | otherwise = error "fromString: invalid infohash string length"
65
66instance Hashable InfoHash where
67 hash = Hashable.hash . getInfoHash
68
69instance BEncode InfoHash where
70 toBEncode = toBEncode . getInfoHash
71 fromBEncode be = InfoHash <$> fromBEncode be
72
73instance Serialize InfoHash where
74 put = putByteString . getInfoHash
75 get = InfoHash <$> getBytes 20
76
77instance URLShow InfoHash where
78 urlShow = show
79
80-- | Hash strict bytestring using SHA1 algorithm.
81hash :: BS.ByteString -> InfoHash
82hash = InfoHash . C.hash
83
84-- | Hash lazy bytestring using SHA1 algorithm.
85hashlazy :: BL.ByteString -> InfoHash
86hashlazy = InfoHash . C.hashlazy
87
88-- | Pretty print info hash in hexadecimal format.
89ppInfoHash :: InfoHash -> Doc
90ppInfoHash = text . BC.unpack . ppHex . getInfoHash
91
92ppHex :: BS.ByteString -> BS.ByteString
93ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed
94
95-- | Add query info hash parameter to uri.
96--
97-- > info_hash=<url_encoded_info_hash>
98--
99addHashToURI :: URI -> InfoHash -> URI
100addHashToURI uri s = uri {
101 uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++
102 "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s))
103 }
104 where
105 mkPref [] = "?"
106 mkPref ('?' : _) = "&"
107 mkPref _ = error "addHashToURI"
108
109 rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c)
110 where
111 unreservedS = (`L.elem` chars)
112 chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./"
113 encodeHex c = '%' : pHex c
114 pHex c = let p = (showHex . ord $ c) ""
115 in if L.length p == 1 then '0' : p else p
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
new file mode 100644
index 00000000..409426be
--- /dev/null
+++ b/src/Data/Torrent/Layout.hs
@@ -0,0 +1,273 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8{-# LANGUAGE BangPatterns #-}
9{-# LANGUAGE FlexibleInstances #-}
10{-# LANGUAGE StandaloneDeriving #-}
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
12{-# LANGUAGE DeriveDataTypeable #-}
13{-# LANGUAGE TemplateHaskell #-}
14{-# OPTIONS -fno-warn-orphans #-}
15module Data.Torrent.Layout
16 ( -- * File attribytes
17 FileOffset
18 , FileSize
19
20 -- * Single file info
21 , FileInfo (..)
22 , fileLength
23 , filePath
24 , fileMD5Sum
25
26 -- * File layout
27 , LayoutInfo (..)
28 , singleFile
29 , multiFile
30 , rootDirName
31 , isSingleFile
32 , isMultiFile
33 , fileNumber
34 , contentLength
35 , blockCount
36
37 -- * Flat file layout
38 , Layout
39 , flatLayout
40 , accumOffsets
41 , fileOffset
42
43 -- * Internal
44 , getLayoutInfo
45 , putLayoutInfo
46 ) where
47
48import Control.Applicative
49import Control.DeepSeq
50import Control.Lens
51import Data.Aeson.TH
52import Data.Aeson.Types (FromJSON, ToJSON)
53import Data.BEncode
54import Data.BEncode.Types
55import Data.ByteString as BS
56import Data.ByteString.Char8 as BC
57import Data.Char
58import Data.List as L
59import Data.Typeable
60import System.FilePath
61import System.Posix.Types
62
63
64{-----------------------------------------------------------------------
65-- File attribytes
66-----------------------------------------------------------------------}
67
68type FileSize = FileOffset
69
70deriving instance FromJSON FileOffset
71deriving instance ToJSON FileOffset
72deriving instance BEncode FileOffset
73
74{-----------------------------------------------------------------------
75-- File info both either from info dict or file list
76-----------------------------------------------------------------------}
77
78-- | Contain info about one single file.
79data FileInfo a = FileInfo {
80 fiLength :: {-# UNPACK #-} !FileSize
81 -- ^ Length of the file in bytes.
82
83 -- TODO unpacked MD5 sum
84 , fiMD5Sum :: !(Maybe ByteString)
85 -- ^ 32 character long MD5 sum of the file. Used by third-party
86 -- tools, not by bittorrent protocol itself.
87
88 , fiName :: !a
89 -- ^ One or more string elements that together represent the
90 -- path and filename. Each element in the list corresponds to
91 -- either a directory name or (in the case of the last
92 -- element) the filename. For example, the file:
93 --
94 -- > "dir1/dir2/file.ext"
95 --
96 -- would consist of three string elements:
97 --
98 -- > ["dir1", "dir2", "file.ext"]
99 --
100 } deriving (Show, Read, Eq, Typeable)
101
102$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)
103
104makeLensesFor
105 [ ("fiLength", "fileLength")
106 , ("fiMD5Sum", "fileMD5Sum")
107 , ("fiName" , "filePath" )
108 ]
109 ''FileInfo
110
111instance NFData a => NFData (FileInfo a) where
112 rnf FileInfo {..} = rnf fiName
113 {-# INLINE rnf #-}
114
115instance BEncode (FileInfo [ByteString]) where
116 toBEncode FileInfo {..} = toDict $
117 "length" .=! fiLength
118 .: "md5sum" .=? fiMD5Sum
119 .: "path" .=! fiName
120 .: endDict
121 {-# INLINE toBEncode #-}
122
123 fromBEncode = fromDict $ do
124 FileInfo <$>! "length"
125 <*>? "md5sum"
126 <*>! "path"
127 {-# INLINE fromBEncode #-}
128
129type Put a = a -> BDict -> BDict
130
131putFileInfoSingle :: Put (FileInfo ByteString)
132putFileInfoSingle FileInfo {..} cont =
133 "length" .=! fiLength
134 .: "md5sum" .=? fiMD5Sum
135 .: "name" .=! fiName
136 .: cont
137
138getFileInfoSingle :: Get (FileInfo ByteString)
139getFileInfoSingle = do
140 FileInfo <$>! "length"
141 <*>? "md5sum"
142 <*>! "name"
143
144instance BEncode (FileInfo ByteString) where
145 toBEncode = toDict . (`putFileInfoSingle` endDict)
146 {-# INLINE toBEncode #-}
147
148 fromBEncode = fromDict getFileInfoSingle
149 {-# INLINE fromBEncode #-}
150
151{-----------------------------------------------------------------------
152-- Original torrent file layout info
153-----------------------------------------------------------------------}
154
155data LayoutInfo
156 = SingleFile
157 { liFile :: !(FileInfo ByteString)
158 }
159 | MultiFile
160 { -- | List of the all files that torrent contains.
161 liFiles :: ![FileInfo [ByteString]]
162
163 -- | The /suggested/ name of the root directory in which to
164 -- store all the files.
165 , liDirName :: !ByteString
166 } deriving (Show, Read, Eq, Typeable)
167
168$(deriveJSON (L.map toLower . L.dropWhile isLower) ''LayoutInfo)
169
170makeLensesFor
171 [ ("liFile" , "singleFile" )
172 , ("liFiles" , "multiFile" )
173 , ("liDirName", "rootDirName")
174 ]
175 ''LayoutInfo
176
177instance NFData LayoutInfo where
178 rnf SingleFile {..} = ()
179 rnf MultiFile {..} = rnf liFiles
180
181getLayoutInfo :: Get LayoutInfo
182getLayoutInfo = single <|> multi
183 where
184 single = SingleFile <$> getFileInfoSingle
185 multi = MultiFile <$>! "files" <*>! "name"
186
187putLayoutInfo :: Put LayoutInfo
188putLayoutInfo SingleFile {..} = putFileInfoSingle liFile
189putLayoutInfo MultiFile {..} = \ cont ->
190 "files" .=! liFiles
191 .: "name" .=! liDirName
192 .: cont
193
194instance BEncode LayoutInfo where
195 toBEncode = toDict . (`putLayoutInfo` endDict)
196 fromBEncode = fromDict getLayoutInfo
197
198-- | Test if this is single file torrent.
199isSingleFile :: LayoutInfo -> Bool
200isSingleFile SingleFile {} = True
201isSingleFile _ = False
202{-# INLINE isSingleFile #-}
203
204-- | Test if this is multifile torrent.
205isMultiFile :: LayoutInfo -> Bool
206isMultiFile MultiFile {} = True
207isMultiFile _ = False
208{-# INLINE isMultiFile #-}
209
210-- | Find sum of sizes of the all torrent files.
211contentLength :: LayoutInfo -> FileSize
212contentLength SingleFile { liFile = FileInfo {..} } = fiLength
213contentLength MultiFile { liFiles = tfs } = sum (L.map fiLength tfs)
214
215-- | Get count of all files in torrent.
216fileNumber :: LayoutInfo -> Int
217fileNumber SingleFile {..} = 1
218fileNumber MultiFile {..} = L.length liFiles
219
220-- | Find number of blocks of the specified size. If torrent size is
221-- not a multiple of block size then the count is rounded up.
222blockCount :: Int -- ^ Block size.
223 -> LayoutInfo -- ^ Torrent content info.
224 -> Int -- ^ Number of blocks.
225blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
226
227{-----------------------------------------------------------------------
228-- Flat layout
229-----------------------------------------------------------------------}
230
231-- | File layout specifies the order and the size of each file in the
232-- storage. Note that order of files is highly important since we
233-- coalesce all the files in the given order to get the linear block
234-- address space.
235--
236type Layout a = [(FilePath, a)]
237
238-- | Extract files layout from torrent info with the given root path.
239flatLayout
240 :: FilePath -- ^ Root path for the all torrent files.
241 -> LayoutInfo -- ^ Torrent content information.
242 -> Layout FileSize -- ^ The all file paths prefixed with the given root.
243flatLayout prefixPath SingleFile { liFile = FileInfo {..} }
244 = [(prefixPath </> BC.unpack fiName, fiLength)]
245flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles
246 where -- TODO use utf8 encoding in name
247 mkPath FileInfo {..} = (path, fiLength)
248 where
249 path = prefixPath </> BC.unpack liDirName
250 </> joinPath (L.map BC.unpack fiName)
251
252accumOffsets :: Layout FileSize -> Layout FileOffset
253accumOffsets = go 0
254 where
255 go !_ [] = []
256 go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs
257
258-- | Gives global offset of a content file for a given full path.
259fileOffset :: FilePath -> Layout FileOffset -> Maybe FileOffset
260fileOffset = lookup
261{-# INLINE fileOffset #-}
262
263{-----------------------------------------------------------------------
264-- Internal utilities
265-----------------------------------------------------------------------}
266
267-- | Divide and round up.
268sizeInBase :: Integral a => a -> Int -> Int
269sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align
270 where
271 align = if n `mod` fromIntegral b == 0 then 0 else 1
272{-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}
273{-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
new file mode 100644
index 00000000..df928b66
--- /dev/null
+++ b/src/Data/Torrent/Magnet.hs
@@ -0,0 +1,236 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- Parsing and rendering of magnet URIs.
9--
10-- For more info see:
11-- <http://magnet-uri.sourceforge.net/magnet-draft-overview.txt>
12--
13-- Bittorrent specific info:
14-- <http://www.bittorrent.org/beps/bep_0009.html>
15--
16module Data.Torrent.Magnet
17 ( -- * Magnet
18 Magnet(..)
19 , nullMagnet
20 , parseMagnet
21 , renderMagnet
22
23 -- ** Extra
24 , fromURI
25 , toURI
26 ) where
27
28import Control.Applicative
29import Control.Monad
30import Data.ByteString as BS
31import Data.ByteString.Base16 as Base16
32import Data.ByteString.Base32 as Base32
33import Data.Map as M
34import Data.Maybe
35import Data.List as L
36import Data.URLEncoded as URL
37import Data.String
38import Data.Text as T
39import Data.Text.Encoding as T
40import Network.URI
41import Text.Read
42
43import Data.Torrent.InfoHash
44
45
46{-----------------------------------------------------------------------
47-- URN
48-----------------------------------------------------------------------}
49
50type NamespaceId = [Text]
51
52btih :: NamespaceId
53btih = ["btih"]
54
55-- | Uniform Resource Name - location-independent, resource
56-- identifier.
57data URN = URN
58 { urnNamespace :: NamespaceId
59 , urnString :: Text
60 } deriving (Eq, Ord)
61
62instance Show URN where
63 showsPrec n = showsPrec n . T.unpack . renderURN
64
65instance IsString URN where
66 fromString = fromMaybe def . parseURN . T.pack
67 where
68 def = error "unable to parse URN"
69
70instance URLShow URN where
71 urlShow = T.unpack . renderURN
72
73parseURN :: Text -> Maybe URN
74parseURN str = case T.split (== ':') str of
75 uriScheme : body
76 | T.toLower uriScheme == "urn" -> mkURN body
77 | otherwise -> Nothing
78 [] -> Nothing
79 where
80 mkURN [] = Nothing
81 mkURN xs = Just $ URN
82 { urnNamespace = L.init xs
83 , urnString = L.last xs
84 }
85
86renderURN :: URN -> Text
87renderURN URN {..}
88 = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]
89
90urnToInfoHash :: URN -> Maybe InfoHash
91urnToInfoHash (URN {..})
92 | urnNamespace /= btih = Nothing
93 | hashLen == 20 = Just $ InfoHash hashStr
94 | hashLen == 32 = Just $ InfoHash $ Base32.decode hashStr
95 | hashLen == 40 = let (ihStr, inv) = Base16.decode hashStr
96 in if BS.length inv == 0
97 then Just $ InfoHash ihStr
98 else Nothing
99 | otherwise = Nothing
100 where
101 hashLen = BS.length hashStr
102 hashStr = T.encodeUtf8 urnString
103
104infoHashToURN :: InfoHash -> URN
105infoHashToURN = URN btih . T.pack . show
106
107{-----------------------------------------------------------------------
108-- Magnet
109-----------------------------------------------------------------------}
110
111-- TODO multiple exact topics
112-- TODO supplement
113
114-- | An URI used to identify torrent.
115data Magnet = Magnet
116 { -- | Resource hash.
117 exactTopic :: !InfoHash
118 -- | Might be used to display name while waiting for metadata.
119 , displayName :: Maybe Text
120 -- | Size of the resource in bytes.
121 , exactLength :: Maybe Integer
122
123 , manifest :: Maybe String
124 -- | Search string.
125 , keywordTopic :: Maybe String
126
127 , acceptableSource :: Maybe URI
128 , exactSource :: Maybe URI
129
130 , tracker :: Maybe URI
131
132 , supplement :: Map Text Text
133 } deriving (Eq, Ord)
134
135instance Show Magnet where
136 show = renderMagnet
137 {-# INLINE show #-}
138
139instance Read Magnet where
140 readsPrec _ xs
141 | Just m <- parseMagnet mstr = [(m, rest)]
142 | otherwise = []
143 where
144 (mstr, rest) = L.break (== ' ') xs
145
146instance IsString Magnet where
147 fromString = fromMaybe def . parseMagnet
148 where
149 def = error "unable to parse magnet"
150
151instance URLEncode Magnet where
152 urlEncode = toQuery
153 {-# INLINE urlEncode #-}
154
155-- | Set exact topic only, other params are empty.
156nullMagnet :: InfoHash -> Magnet
157nullMagnet u = Magnet
158 { exactTopic = u
159 , displayName = Nothing
160 , exactLength = Nothing
161 , manifest = Nothing
162 , keywordTopic = Nothing
163 , acceptableSource = Nothing
164 , exactSource = Nothing
165 , tracker = Nothing
166 , supplement = M.empty
167 }
168
169fromQuery :: URLEncoded -> Either String Magnet
170fromQuery q
171 | Just urnStr <- URL.lookup ("xt" :: String) q
172 , Just urn <- parseURN $ T.pack urnStr
173 , Just infoHash <- urnToInfoHash urn
174 = return $ Magnet
175 { exactTopic = infoHash
176 , displayName = T.pack <$> URL.lookup ("dn" :: String) q
177 , exactLength = readMaybe =<< URL.lookup ("xl" :: String) q
178
179 , manifest = URL.lookup ("mt" :: String) q
180 , keywordTopic = URL.lookup ("kt" :: String) q
181
182 , acceptableSource = parseURI =<< URL.lookup ("as" :: String) q
183 , exactSource = parseURI =<< URL.lookup ("xs" :: String) q
184
185 , tracker = parseURI =<< URL.lookup ("tr" :: String) q
186 , supplement = M.empty
187 }
188
189 | otherwise = Left "exact topic not defined"
190
191toQuery :: Magnet -> URLEncoded
192toQuery Magnet {..}
193 = s "xt" %= infoHashToURN exactTopic
194 %& s "dn" %=? (T.unpack <$> displayName)
195 %& s "xl" %=? exactLength
196 %& s "mt" %=? manifest
197 %& s "kt" %=? keywordTopic
198 %& s "as" %=? acceptableSource
199 %& s "xs" %=? exactSource
200 %& s "tr" %=? tracker
201 where
202 s :: String -> String; s = id
203
204magnetScheme :: URI
205magnetScheme = URI
206 { uriScheme = "magnet:"
207 , uriAuthority = Nothing
208 , uriPath = ""
209 , uriQuery = ""
210 , uriFragment = ""
211 }
212
213isMagnetURI :: URI -> Bool
214isMagnetURI u = u { uriQuery = "" } == magnetScheme
215
216-- | The same as 'parseMagnet' but useful if you alread have a parsed
217-- uri.
218fromURI :: URI -> Either String Magnet
219fromURI u @ URI {..}
220 | not (isMagnetURI u) = Left "this is not a magnet link"
221 | otherwise = importURI u >>= fromQuery
222
223-- | The same as 'renderMagnet' but useful if you need an uri.
224toURI :: Magnet -> URI
225toURI m = magnetScheme %? urlEncode m
226
227etom :: Either a b -> Maybe b
228etom = either (const Nothing) Just
229
230-- | Try to parse magnet link from urlencoded string.
231parseMagnet :: String -> Maybe Magnet
232parseMagnet = parseURI >=> etom . fromURI
233
234-- | Render magnet link to urlencoded string
235renderMagnet :: Magnet -> String
236renderMagnet = show . toURI
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
new file mode 100644
index 00000000..ea4e6253
--- /dev/null
+++ b/src/Data/Torrent/Piece.hs
@@ -0,0 +1,203 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE DeriveDataTypeable #-}
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11module Data.Torrent.Piece
12 ( -- * Piece attributes
13 -- ** Piece size
14 PieceSize (..)
15 , defaultBlockSize -- TODO use data-default
16 , optimalPieceCount
17 , defaultPieceSize -- TODO use data-default
18
19 -- ** Piece index
20 , PieceIx
21
22 -- * Piece data
23 , Piece (..)
24 , ppPiece
25
26 -- * Piece control
27 , PieceInfo (..)
28 , ppPieceInfo
29 , pieceLength
30 , pieceHashes
31 , pieceHash
32 , pieceCount
33 , checkPieceLazy
34
35
36 -- * Internal
37 , getPieceInfo
38 , putPieceInfo
39 ) where
40
41import Control.DeepSeq
42import Control.Lens
43import qualified Crypto.Hash.SHA1 as SHA1
44import Data.Aeson (ToJSON, FromJSON)
45import Data.Aeson.TH
46import Data.BEncode
47import Data.BEncode.Types
48import Data.Bits
49import Data.Bits.Extras
50import Data.ByteString as BS
51import qualified Data.ByteString.Lazy as BL
52import Data.Char
53import Data.Int
54import Data.List as L
55import Data.Typeable
56import Text.PrettyPrint
57
58
59class Lint a where
60 lint :: a -> Either String a
61
62type PieceCount = Int -- TODO newtype
63type PieceIx = Int -- TODO remove
64
65newtype PieceIndex = PieceIndex Int
66
67-- | An int used to denote piece size.
68newtype PieceSize = PieceSize Int
69 deriving (Show, Read, Typeable
70 , Eq, Ord, Enum
71 , Num, Real, Integral
72 , BEncode, ToJSON, FromJSON
73 )
74
75-- | Widely used semi-official block size.
76defaultBlockSize :: Int
77defaultBlockSize = 16 * 1024
78
79maxPieceSize :: Int
80maxPieceSize = 4 * 1024 * 1024
81{-# INLINE maxPieceSize #-}
82
83minPieceSize :: Int
84minPieceSize = defaultBlockSize * 4
85{-# INLINE minPieceSize #-}
86
87-- | NOTE: Have max and min size constrained to wide used
88-- semi-standard values. This bounds should be used to make decision
89-- about piece size for new torrents.
90--
91instance Bounded PieceSize where
92 maxBound = PieceSize maxPieceSize
93 {-# INLINE maxBound #-}
94
95 minBound = PieceSize minPieceSize
96 {-# INLINE minBound #-}
97
98-- | TODO
99optimalPieceCount :: Int
100optimalPieceCount = 1000
101{-# INLINE optimalPieceCount #-}
102
103toPow2 :: Int -> Int
104toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)
105
106-- | Find the optimal piece size for a given torrent size.
107defaultPieceSize :: Int64 -> Int
108defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc
109 where
110 pc = fromIntegral (x `div` fromIntegral optimalPieceCount)
111
112-- TODO check if pieceLength is power of 2
113-- | Piece payload should be strict or lazy bytestring.
114data Piece a = Piece
115 { -- | Zero-based piece index in torrent. TODO how pieces are indexed?
116 pieceIndex :: {-# UNPACK #-} !PieceIx
117 -- | Payload.
118 , pieceData :: !a
119 } deriving (Show, Read, Eq, Typeable)
120
121$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece)
122
123instance NFData (Piece a)
124
125-- | Format piece in human readable form. Payload bytes are omitted.
126ppPiece :: Piece a -> Doc
127ppPiece Piece {..}
128 = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
129
130data PieceInfo = PieceInfo
131 { piPieceLength :: {-# UNPACK #-} !PieceSize
132 -- ^ Number of bytes in each piece.
133
134 , piPieceHashes :: !ByteString
135 -- ^ Concatenation of all 20-byte SHA1 hash values.
136 } deriving (Show, Read, Eq, Typeable)
137
138$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PieceInfo)
139
140-- | Number of bytes in each piece.
141makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
142
143-- | Concatenation of all 20-byte SHA1 hash values.
144makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo
145
146instance NFData PieceInfo
147
148instance Lint PieceInfo where
149 lint pinfo @ PieceInfo {..}
150 | BS.length piPieceHashes `rem` hashsize == 0
151 , piPieceLength >= 0 = return pinfo
152 | otherwise = Left undefined
153
154
155putPieceInfo :: PieceInfo -> BDict -> BDict
156putPieceInfo PieceInfo {..} cont =
157 "piece length" .=! piPieceLength
158 .: "pieces" .=! piPieceHashes
159 .: cont
160
161getPieceInfo :: Get PieceInfo
162getPieceInfo = do
163 PieceInfo <$>! "piece length"
164 <*>! "pieces"
165
166instance BEncode PieceInfo where
167 toBEncode = toDict . (`putPieceInfo` endDict)
168 fromBEncode = fromDict getPieceInfo
169
170-- | Format piece info in human readable form. Hashes are omitted.
171ppPieceInfo :: PieceInfo -> Doc
172ppPieceInfo PieceInfo { piPieceLength = PieceSize len } =
173 "PieceInfo" <+> braces ("length" <+> "=" <+> int len)
174
175hashsize :: Int
176hashsize = 20
177{-# INLINE hashsize #-}
178
179slice :: Int -> Int -> ByteString -> ByteString
180slice start len = BS.take len . BS.drop start
181{-# INLINE slice #-}
182
183-- | Extract validation hash by specified piece index.
184pieceHash :: PieceInfo -> PieceIx -> ByteString
185pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize piPieceHashes
186
187-- | Find count of pieces in the torrent. If torrent size is not a
188-- multiple of piece size then the count is rounded up.
189pieceCount :: PieceInfo -> PieceCount
190pieceCount PieceInfo {..} = BS.length piPieceHashes `quot` hashsize
191
192isLastPiece :: PieceInfo -> PieceIx -> Bool
193isLastPiece ci i = pieceCount ci == succ i
194
195class Validation a where
196 validate :: PieceInfo -> Piece a -> Bool
197
198-- | Validate piece with metainfo hash.
199checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool
200checkPieceLazy pinfo @ PieceInfo {..} Piece {..}
201 = (fromIntegral (BL.length pieceData) == piPieceLength
202 || isLastPiece pinfo pieceIndex)
203 && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs
new file mode 100644
index 00000000..e9a337a1
--- /dev/null
+++ b/src/Data/Torrent/Tree.hs
@@ -0,0 +1,71 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE TemplateHaskell #-}
10{-# LANGUAGE DeriveDataTypeable #-}
11module Data.Torrent.Tree
12 ( DirTree (..)
13 , build
14
15 , Data.Torrent.Tree.lookup
16 , lookupDir
17
18 , fileCount
19 , dirCount
20 ) where
21
22import Control.Arrow
23import Data.ByteString as BS
24import Data.ByteString.Char8 as BC
25import Data.Foldable
26import Data.List as L
27import Data.Map as M
28import Data.Monoid
29
30import Data.Torrent.Layout
31
32
33data DirTree a = Dir { children :: Map ByteString (DirTree a) }
34 | File { node :: FileInfo a }
35 deriving Show
36
37build :: LayoutInfo -> DirTree ()
38build SingleFile {liFile = FileInfo {..}} = Dir
39 { children = M.singleton fiName (File fi) }
40 where
41 fi = FileInfo fiLength fiMD5Sum ()
42build MultiFile {..} = Dir $ M.singleton liDirName files
43 where
44 files = Dir $ M.fromList $ L.map mkFileEntry liFiles
45 mkFileEntry FileInfo {..} = (L.head fiName, ent) -- TODO FIXME
46 where
47 ent = File $ FileInfo fiLength fiMD5Sum ()
48
49decompress :: DirTree () -> [FileInfo ()]
50decompress = undefined
51
52lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
53lookup [] t = Just t
54lookup (p : ps) (Dir m) | Just subTree <- M.lookup (BC.pack p) m
55 = Data.Torrent.Tree.lookup ps subTree
56lookup _ _ = Nothing
57
58lookupDir :: [FilePath] -> DirTree a -> Maybe [(ByteString, DirTree a)]
59lookupDir ps d
60 | Just subTree <- Data.Torrent.Tree.lookup ps d =
61 case subTree of
62 File _ -> Nothing
63 Dir es -> Just $ M.toList es
64
65fileCount :: DirTree a -> Sum Int
66fileCount File {..} = Sum 1
67fileCount Dir {..} = foldMap fileCount children
68
69dirCount :: DirTree a -> Sum Int
70dirCount File {..} = Sum 0
71dirCount Dir {..} = Sum 1 <> foldMap dirCount children
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-22 20:33:17 +0000