summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-08-16 08:50:08 +0400
committerSam T <pxqr.sta@gmail.com>2013-08-16 08:50:08 +0400
commit6bb92a610c4874ea3fa37fb15cd55c48f219d6ed (patch)
treee9362f06242d11a55cade4d8705155c6d388a85e /src/Data
parent1c19636c20e918388ef7f16faa8c6fb617d917d8 (diff)
~ Remove torrent-content modules.
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Bitfield.hs359
-rw-r--r--src/Data/Torrent.hs511
2 files changed, 0 insertions, 870 deletions
diff --git a/src/Data/Bitfield.hs b/src/Data/Bitfield.hs
deleted file mode 100644
index acfca0d0..00000000
--- a/src/Data/Bitfield.hs
+++ /dev/null
@@ -1,359 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- This modules provides all necessary machinery to work with
9-- bitfields. Bitfields are used to keep track indices of complete
10-- pieces either peer have or client have.
11--
12-- There are also commonly used piece seletion algorithms
13-- which used to find out which one next piece to download.
14-- Selectors considered to be used in the following order:
15--
16-- * Random first - at the start.
17--
18-- * Rarest first selection - performed to avoid situation when
19-- rarest piece is unaccessible.
20--
21-- * _End game_ seletion - performed after a peer has requested all
22-- the subpieces of the content.
23--
24-- Note that BitTorrent applies the strict priority policy for
25-- /subpiece/ or /blocks/ selection.
26--
27{-# LANGUAGE CPP #-}
28{-# LANGUAGE BangPatterns #-}
29{-# LANGUAGE RecordWildCards #-}
30module Data.Bitfield
31 ( PieceIx, PieceCount, Bitfield
32
33 -- * Construction
34 , haveAll, haveNone, have, singleton
35 , interval
36 , adjustSize
37
38 -- * Query
39 , Data.Bitfield.null
40 , haveCount, totalCount, completeness
41
42 , member, notMember
43 , findMin, findMax
44
45 , isSubsetOf
46
47 , Frequency, frequencies, rarest
48
49 -- * Combine
50 , union
51 , intersection
52 , difference
53
54 -- * Serialization
55 , fromBitmap, toBitmap
56 , toList
57
58 -- * Selection
59 , Selector
60 , selector, strategyClass
61
62 , strictFirst, strictLast
63 , rarestFirst, randomFirst, endGame
64
65#if defined (TESTING)
66 -- * Debug
67 , mkBitfield
68#endif
69 ) where
70
71import Control.Monad
72import Control.Monad.ST
73import Data.ByteString (ByteString)
74import qualified Data.ByteString as B
75import qualified Data.ByteString.Lazy as Lazy
76import Data.Vector.Unboxed (Vector)
77import qualified Data.Vector.Unboxed as V
78import qualified Data.Vector.Unboxed.Mutable as VM
79import Data.IntervalSet (IntSet)
80import qualified Data.IntervalSet as S
81import qualified Data.IntervalSet.ByteString as S
82import Data.List (foldl')
83import Data.Monoid
84import Data.Ratio
85
86
87-- | Pieces indexed from zero up to 'PieceCount' value.
88type PieceIx = Int
89
90-- | Used to represent max set bound. Min set bound is always set to
91-- zero.
92type PieceCount = Int
93
94-- TODO cache some operations
95
96-- | Bitfields are represented just as integer sets but with
97-- restriction: the each set should be within given interval (or
98-- subset of the specified interval). Size is used to specify
99-- interval, so bitfield of size 10 might contain only indices in
100-- interval [0..9].
101--
102data Bitfield = Bitfield {
103 bfSize :: !PieceCount
104 , bfSet :: !IntSet
105 } deriving (Show, Read, Eq)
106
107-- Invariants: all elements of bfSet lie in [0..bfSize - 1];
108
109instance Monoid Bitfield where
110 {-# SPECIALIZE instance Monoid Bitfield #-}
111 mempty = haveNone 0
112 mappend = union
113 mconcat = unions
114
115{-----------------------------------------------------------------------
116 Construction
117-----------------------------------------------------------------------}
118
119-- | The empty bitfield of the given size.
120haveNone :: PieceCount -> Bitfield
121haveNone s = Bitfield s S.empty
122
123-- | The full bitfield containing all piece indices for the given size.
124haveAll :: PieceCount -> Bitfield
125haveAll s = Bitfield s (S.interval 0 (s - 1))
126
127-- | Insert the index in the set ignoring out of range indices.
128have :: PieceIx -> Bitfield -> Bitfield
129have ix Bitfield {..}
130 | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
131 | otherwise = Bitfield bfSize bfSet
132
133singleton :: PieceIx -> PieceCount -> Bitfield
134singleton ix pc = have ix (haveNone pc)
135
136-- | Assign new size to bitfield. FIXME Normally, size should be only
137-- decreased, otherwise exception raised.
138adjustSize :: PieceCount -> Bitfield -> Bitfield
139adjustSize s Bitfield {..} = Bitfield s bfSet
140
141-- | NOTE: for internal use only
142interval :: PieceCount -> PieceIx -> PieceIx -> Bitfield
143interval pc a b = Bitfield pc (S.interval a b)
144
145{-----------------------------------------------------------------------
146 Query
147-----------------------------------------------------------------------}
148
149-- | Test if bitifield have no one index: peer do not have anything.
150null :: Bitfield -> Bool
151null Bitfield {..} = S.null bfSet
152
153-- | Count of peer have pieces.
154haveCount :: Bitfield -> PieceCount
155haveCount = S.size . bfSet
156
157-- | Total count of pieces and its indices.
158totalCount :: Bitfield -> PieceCount
159totalCount = bfSize
160
161-- | Ratio of /have/ piece count to the /total/ piece count.
162--
163-- > forall bf. 0 <= completeness bf <= 1
164--
165completeness :: Bitfield -> Ratio PieceCount
166completeness b = haveCount b % totalCount b
167
168inRange :: PieceIx -> Bitfield -> Bool
169inRange ix Bitfield {..} = 0 <= ix && ix < bfSize
170
171member :: PieceIx -> Bitfield -> Bool
172member ix bf @ Bitfield {..}
173 | ix `inRange` bf = ix `S.member` bfSet
174 | otherwise = False
175
176notMember :: PieceIx -> Bitfield -> Bool
177notMember ix bf @ Bitfield {..}
178 | ix `inRange` bf = ix `S.notMember` bfSet
179 | otherwise = True
180
181-- | Find first available piece index.
182findMin :: Bitfield -> PieceIx
183findMin = S.findMin . bfSet
184{-# INLINE findMin #-}
185
186-- | Find last available piece index.
187findMax :: Bitfield -> PieceIx
188findMax = S.findMax . bfSet
189{-# INLINE findMax #-}
190
191isSubsetOf :: Bitfield -> Bitfield -> Bool
192isSubsetOf a b = bfSet a `S.isSubsetOf` bfSet b
193
194-- | Frequencies are needed in piece selection startegies which use
195-- availability quantity to find out the optimal next piece index to
196-- download.
197type Frequency = Int
198
199-- | How many times each piece index occur in the given bitfield set.
200frequencies :: [Bitfield] -> Vector Frequency
201frequencies [] = V.fromList []
202frequencies xs = runST $ do
203 v <- VM.new size
204 VM.set v 0
205 forM_ xs $ \ Bitfield {..} -> do
206 forM_ (S.toList bfSet) $ \ x -> do
207 fr <- VM.read v x
208 VM.write v x (succ fr)
209 V.unsafeFreeze v
210 where
211 size = maximum (map bfSize xs)
212
213-- TODO it seems like this operation is veeery slow
214
215-- | Find least available piece index. If no piece available return
216-- 'Nothing'.
217rarest :: [Bitfield] -> Maybe PieceIx
218rarest xs
219 | V.null freqMap = Nothing
220 | otherwise
221 = Just $ fst $ V.ifoldr' minIx (0, freqMap V.! 0) freqMap
222 where
223 freqMap = frequencies xs
224
225 minIx :: PieceIx -> Frequency
226 -> (PieceIx, Frequency)
227 -> (PieceIx, Frequency)
228 minIx ix fr acc@(_, fra)
229 | fr < fra && fr > 0 = (ix, fr)
230 | otherwise = acc
231
232
233{-----------------------------------------------------------------------
234 Combine
235-----------------------------------------------------------------------}
236
237-- | Find indices at least one peer have.
238union :: Bitfield -> Bitfield -> Bitfield
239union a b = {-# SCC union #-} Bitfield {
240 bfSize = bfSize a `max` bfSize b
241 , bfSet = bfSet a `S.union` bfSet b
242 }
243
244-- | Find indices both peers have.
245intersection :: Bitfield -> Bitfield -> Bitfield
246intersection a b = {-# SCC intersection #-} Bitfield {
247 bfSize = bfSize a `min` bfSize b
248 , bfSet = bfSet a `S.intersection` bfSet b
249 }
250
251-- | Find indices which have first peer but do not have the second peer.
252difference :: Bitfield -> Bitfield -> Bitfield
253difference a b = {-# SCC difference #-} Bitfield {
254 bfSize = bfSize a -- FIXME is it reasonable?
255 , bfSet = bfSet a `S.difference` bfSet b
256 }
257
258-- | Find indices the any of the peers have.
259unions :: [Bitfield] -> Bitfield
260unions = {-# SCC unions #-} foldl' union (haveNone 0)
261
262{-----------------------------------------------------------------------
263 Serialization
264-----------------------------------------------------------------------}
265
266-- | List all have indexes.
267toList :: Bitfield -> [PieceIx]
268toList Bitfield {..} = S.toList bfSet
269
270-- | Unpack 'Bitfield' from tightly packed bit array. Note resulting
271-- size might be more than real bitfield size, use 'adjustSize'.
272fromBitmap :: ByteString -> Bitfield
273fromBitmap bs = {-# SCC fromBitmap #-} Bitfield {
274 bfSize = B.length bs * 8
275 , bfSet = S.fromByteString bs
276 }
277{-# INLINE fromBitmap #-}
278
279-- | Pack a 'Bitfield' to tightly packed bit array.
280toBitmap :: Bitfield -> Lazy.ByteString
281toBitmap Bitfield {..} = {-# SCC toBitmap #-} Lazy.fromChunks [intsetBM, alignment]
282 where
283 byteSize = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1
284 alignment = B.replicate (byteSize - B.length intsetBM) 0
285 intsetBM = S.toByteString bfSet
286
287{-----------------------------------------------------------------------
288 Debug
289-----------------------------------------------------------------------}
290
291-- | For internal use only.
292mkBitfield :: PieceCount -> [PieceIx] -> Bitfield
293mkBitfield s ixs = Bitfield {
294 bfSize = s
295 , bfSet = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
296 }
297
298{-----------------------------------------------------------------------
299 Selection
300-----------------------------------------------------------------------}
301
302type Selector = Bitfield -- ^ Indices of client /have/ pieces.
303 -> Bitfield -- ^ Indices of peer /have/ pieces.
304 -> [Bitfield] -- ^ Indices of other peers /have/ pieces.
305 -> Maybe PieceIx -- ^ Zero-based index of piece to request
306 -- to, if any.
307
308selector :: Selector -- ^ Selector to use at the start.
309 -> Ratio PieceCount
310 -> Selector -- ^ Selector to use after the client have
311 -- the C pieces.
312 -> Selector -- ^ Selector that changes behaviour based
313 -- on completeness.
314selector start pt ready h a xs =
315 case strategyClass pt h of
316 SCBeginning -> start h a xs
317 SCReady -> ready h a xs
318 SCEnd -> endGame h a xs
319
320data StartegyClass
321 = SCBeginning
322 | SCReady
323 | SCEnd
324 deriving (Show, Eq, Ord, Enum, Bounded)
325
326
327strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
328strategyClass threshold = classify . completeness
329 where
330 classify c
331 | c < threshold = SCBeginning
332 | c + 1 % numerator c < 1 = SCReady
333 -- FIXME numerator have is not total count
334 | otherwise = SCEnd
335
336
337-- | Select the first available piece.
338strictFirst :: Selector
339strictFirst h a _ = Just $ findMin (difference a h)
340
341-- | Select the last available piece.
342strictLast :: Selector
343strictLast h a _ = Just $ findMax (difference a h)
344
345-- |
346rarestFirst :: Selector
347rarestFirst h a xs = rarest (map (intersection want) xs)
348 where
349 want = difference h a
350
351-- | In average random first is faster than rarest first strategy but
352-- only if all pieces are available.
353randomFirst :: Selector
354randomFirst = do
355-- randomIO
356 error "randomFirst"
357
358endGame :: Selector
359endGame = strictLast
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
deleted file mode 100644
index 36974ccf..00000000
--- a/src/Data/Torrent.hs
+++ /dev/null
@@ -1,511 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- Torrent file contains metadata about files and folders but not
9-- content itself. The files are bencoded dictionaries. There is
10-- also other info which is used to help join the swarm.
11--
12-- This module provides torrent metainfo serialization and info hash
13-- extraction.
14--
15-- For more info see:
16-- <http://www.bittorrent.org/beps/bep_0003.html#metainfo-files>,
17-- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure>
18--
19{-# LANGUAGE CPP #-}
20{-# LANGUAGE FlexibleInstances #-}
21{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE GeneralizedNewtypeDeriving #-}
23{-# LANGUAGE TemplateHaskell #-}
24{-# OPTIONS -fno-warn-orphans #-}
25-- TODO refine interface
26module Data.Torrent
27 ( -- * Torrent
28 Torrent(..), ContentInfo(..), FileInfo(..)
29 , mktorrent, simpleTorrent
30 , torrentExt, isTorrentPath
31 , fromFile
32
33 -- * Files layout
34 , Layout, contentLayout
35 , contentLength, fileCount, fileOffset
36 , pieceCount, blockCount
37 , isSingleFile, isMultiFile
38
39 , checkPiece
40
41 -- * Info hash
42#if defined (TESTING)
43 , InfoHash(..)
44#else
45 , InfoHash(..)
46#endif
47 , ppInfoHash
48 , addHashToURI
49
50 -- * Extra
51 , sizeInBase
52
53-- #if defined (TESTING)
54 -- * Internal
55 , Data.Torrent.hash
56 , Data.Torrent.hashlazy
57 , layoutOffsets
58 , slice
59-- #endif
60 ) where
61
62import Prelude hiding (sum)
63
64import Control.Applicative
65import Control.Arrow
66import Control.Exception
67import Control.Monad
68
69import qualified Crypto.Hash.SHA1 as C
70
71import Data.Aeson
72import Data.Aeson.TH
73import Data.BEncode as BE
74import Data.Char
75import Data.Foldable
76import qualified Data.ByteString as B
77import Data.ByteString.Internal
78import qualified Data.ByteString.Char8 as BC (pack, unpack)
79import qualified Data.ByteString.Lazy as Lazy
80import qualified Data.ByteString.Lazy.Builder as B
81import qualified Data.ByteString.Lazy.Builder.ASCII as B
82import qualified Data.List as L
83import Data.Map (Map)
84import qualified Data.Map as M
85import Data.Hashable as Hashable
86import Data.Text (Text)
87import Data.Serialize as S hiding (Result)
88import Text.PrettyPrint
89import Text.ParserCombinators.ReadP as P
90
91import Network.URI
92import System.FilePath
93import Numeric
94
95{-----------------------------------------------------------------------
96 Info hash
97-----------------------------------------------------------------------}
98
99-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
100newtype InfoHash = InfoHash { getInfoHash :: ByteString }
101 deriving (Eq, Ord, ToJSON, FromJSON)
102
103instance Show InfoHash where
104 show = render . ppInfoHash
105
106instance Read InfoHash where
107 readsPrec _ = readP_to_S $ do
108 str <- replicateM 40 (satisfy isHexDigit)
109 return $ InfoHash $ decodeIH str
110 where
111 decodeIH = B.pack . map fromHex . pair
112 fromHex (a, b) = read $ '0' : 'x' : a : b : []
113
114 pair (a : b : xs) = (a, b) : pair xs
115 pair _ = []
116
117instance Hashable InfoHash where
118 hash = Hashable.hash . getInfoHash
119
120instance BEncodable InfoHash where
121 toBEncode = toBEncode . getInfoHash
122 fromBEncode be = InfoHash <$> fromBEncode be
123
124instance Serialize InfoHash where
125 put = putByteString . getInfoHash
126 get = InfoHash <$> getBytes 20
127
128instance BEncodable a => BEncodable (Map InfoHash a) where
129 {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-}
130 fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b
131 {-# INLINE fromBEncode #-}
132
133 toBEncode = toBEncode . M.mapKeys getInfoHash
134 {-# INLINE toBEncode #-}
135
136-- | Hash strict bytestring using SHA1 algorithm.
137hash :: ByteString -> InfoHash
138hash = InfoHash . C.hash
139
140-- | Hash lazy bytestring using SHA1 algorithm.
141hashlazy :: Lazy.ByteString -> InfoHash
142hashlazy = InfoHash . C.hashlazy
143
144-- | Pretty print info hash in hexadecimal format.
145ppInfoHash :: InfoHash -> Doc
146ppInfoHash = text . BC.unpack . ppHex . getInfoHash
147
148ppHex :: ByteString -> ByteString
149ppHex = Lazy.toStrict . B.toLazyByteString . B.byteStringHexFixed
150
151-- | Add query info hash parameter to uri.
152--
153-- > info_hash=<url_encoded_info_hash>
154--
155addHashToURI :: URI -> InfoHash -> URI
156addHashToURI uri s = uri {
157 uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++
158 "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s))
159 }
160 where
161 mkPref [] = "?"
162 mkPref ('?' : _) = "&"
163 mkPref _ = error "addHashToURI"
164
165 rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c)
166 where
167 unreservedS = (`L.elem` chars)
168 chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./"
169 encodeHex c = '%' : pHex c
170 pHex c = let p = (showHex . ord $ c) ""
171 in if L.length p == 1 then '0' : p else p
172
173{-----------------------------------------------------------------------
174 Torrent metainfo
175-----------------------------------------------------------------------}
176
177type Time = Text
178
179-- | Contain info about one single file.
180data FileInfo = FileInfo {
181 fiLength :: !Integer
182 -- ^ Length of the file in bytes.
183
184 , fiMD5sum :: Maybe ByteString
185 -- ^ 32 character long MD5 sum of the file.
186 -- Used by third-party tools, not by bittorrent protocol itself.
187
188 , fiPath :: ![ByteString]
189 -- ^ One or more string elements that together represent the
190 -- path and filename. Each element in the list corresponds to
191 -- either a directory name or (in the case of the last
192 -- element) the filename. For example, the file:
193 --
194 -- > "dir1/dir2/file.ext"
195 --
196 -- would consist of three string elements:
197 --
198 -- > ["dir1", "dir2", "file.ext"]
199 --
200 } deriving (Show, Read, Eq)
201
202$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)
203
204
205-- | Info part of the .torrent file contain info about each content file.
206data ContentInfo =
207 SingleFile {
208 ciLength :: !Integer
209 -- ^ Length of the file in bytes.
210
211 , ciMD5sum :: Maybe ByteString
212 -- ^ 32 character long MD5 sum of the file.
213 -- Used by third-party tools, not by bittorrent protocol itself.
214
215 , ciName :: !ByteString
216 -- ^ Suggested name of the file single file.
217
218
219
220 , ciPieceLength :: !Int
221 -- ^ Number of bytes in each piece.
222
223 , ciPieces :: !ByteString
224 -- ^ Concatenation of all 20-byte SHA1 hash values.
225
226 , ciPrivate :: Maybe Bool
227 -- ^ If set the client MUST publish its presence to get other
228 -- peers ONLY via the trackers explicity described in the
229 -- metainfo file.
230 --
231 -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html>
232 }
233
234 | MultiFile {
235 ciFiles :: ![FileInfo]
236 -- ^ List of the all files that torrent contains.
237
238 , ciName :: !ByteString
239 -- | The file path of the directory in which to store all the files.
240
241 , ciPieceLength :: !Int
242 , ciPieces :: !ByteString
243 , ciPrivate :: Maybe Bool
244 } deriving (Show, Read, Eq)
245
246$(deriveJSON id ''ContentInfo)
247
248-- TODO more convenient form of torrent info.
249-- | Metainfo about particular torrent.
250data Torrent = Torrent {
251 tInfoHash :: !InfoHash
252 -- ^ SHA1 hash of the 'TorrentInfo' of the 'Torrent'.
253
254 , tAnnounce :: !URI
255 -- ^ The URL of the tracker.
256
257 -- NOTE: out of lexicographic order!
258 , tInfo :: !ContentInfo
259 -- ^ Info about each content file.
260
261 , tAnnounceList :: Maybe [[URI]]
262 -- ^ Announce list add multiple tracker support.
263 --
264 -- BEP 12: <http://www.bittorrent.org/beps/bep_0012.html>
265
266 , tComment :: Maybe Text
267 -- ^ Free-form comments of the author.
268
269 , tCreatedBy :: Maybe ByteString
270 -- ^ Name and version of the program used to create the .torrent.
271
272 , tCreationDate :: Maybe Time
273 -- ^ Creation time of the torrent, in standard UNIX epoch.
274
275 , tEncoding :: Maybe ByteString
276 -- ^ String encoding format used to generate the pieces part of
277 -- the info dictionary in the .torrent metafile.
278
279 , tPublisher :: Maybe URI
280 -- ^ Containing the RSA public key of the publisher of the
281 -- torrent. Private counterpart of this key that has the
282 -- authority to allow new peers onto the swarm.
283
284 , tPublisherURL :: Maybe URI
285 , tSignature :: Maybe ByteString
286 -- ^ The RSA signature of the info dictionary (specifically,
287 -- the encrypted SHA-1 hash of the info dictionary).
288 } deriving (Show, Eq)
289
290instance Hashable Torrent where
291 hash = Hashable.hash . tInfoHash
292
293{- note that info hash is actually reduntant field
294 but it's better to keep it here to avoid heavy recomputations
295-}
296
297-- | Smart constructor for 'Torrent' which compute info hash.
298mktorrent :: URI -> ContentInfo
299 -> Maybe [[URI]] -> Maybe Text -> Maybe ByteString
300 -> Maybe Time -> Maybe ByteString -> Maybe URI
301 -> Maybe URI -> Maybe ByteString
302 -> Torrent
303mktorrent announce info = Torrent (hashlazy (BE.encoded info)) announce info
304
305-- | A simple torrent contains only required fields.
306simpleTorrent :: URI -> ContentInfo -> Torrent
307simpleTorrent announce info = mktorrent announce info
308 Nothing Nothing Nothing
309 Nothing Nothing Nothing
310 Nothing Nothing
311
312-- TODO check if pieceLength is power of 2
313
314instance BEncodable URI where
315 toBEncode uri = toBEncode (BC.pack (uriToString id uri ""))
316 {-# INLINE toBEncode #-}
317
318 fromBEncode (BString s) | Just url <- parseURI (BC.unpack s) = return url
319 fromBEncode b = decodingError $ "url <" ++ show b ++ ">"
320 {-# INLINE fromBEncode #-}
321
322instance BEncodable Torrent where
323 toBEncode Torrent {..} = fromAscAssocs
324 [ "announce" --> tAnnounce
325 , "announce-list" -->? tAnnounceList
326 , "comment" -->? tComment
327 , "created by" -->? tCreatedBy
328 , "creation date" -->? tCreationDate
329 , "encoding" -->? tEncoding
330 , "info" --> tInfo
331 , "publisher" -->? tPublisher
332 , "publisher-url" -->? tPublisherURL
333 , "signature" -->? tSignature
334 ]
335
336 fromBEncode (BDict d) | Just info <- M.lookup "info" d =
337 Torrent <$> pure (hashlazy (BE.encode info)) -- WARN
338 <*> d >-- "announce"
339 <*> d >-- "info"
340 <*> d >--? "announce-list"
341 <*> d >--? "comment"
342 <*> d >--? "created by"
343 <*> d >--? "creation date"
344 <*> d >--? "encoding"
345 <*> d >--? "publisher"
346 <*> d >--? "publisher-url"
347 <*> d >--? "signature"
348
349 fromBEncode _ = decodingError "Torrent"
350
351
352instance BEncodable ContentInfo where
353 toBEncode SingleFile {..} = fromAscAssocs
354 [ "length" --> ciLength
355 , "md5sum" -->? ciMD5sum
356 , "name" --> ciName
357
358 , "piece length" --> ciPieceLength
359 , "pieces" --> ciPieces
360 , "private" -->? ciPrivate
361 ]
362
363 toBEncode MultiFile {..} = fromAscAssocs
364 [ "files" --> ciFiles
365 , "name" --> ciName
366
367 , "piece length" --> ciPieceLength
368 , "pieces" --> ciPieces
369 , "private" -->? ciPrivate
370 ]
371
372 fromBEncode (BDict d)
373 | Just (BList fs) <- M.lookup "files" d =
374 MultiFile <$> mapM fromBEncode fs
375 <*> d >-- "name"
376 <*> d >-- "piece length"
377 <*> d >-- "pieces"
378 <*> d >--? "private"
379 | otherwise =
380 SingleFile <$> d >-- "length"
381 <*> d >--? "md5sum"
382 <*> d >-- "name"
383 <*> d >-- "piece length"
384 <*> d >-- "pieces"
385 <*> d >--? "private"
386 fromBEncode _ = decodingError "ContentInfo"
387
388
389instance BEncodable FileInfo where
390 toBEncode FileInfo {..} = fromAssocs
391 [ "length" --> fiLength
392 , "md5sum" -->? fiMD5sum
393 , "path" --> fiPath
394 ]
395
396 fromBEncode (BDict d) =
397 FileInfo <$> d >-- "length"
398 <*> d >--? "md5sum"
399 <*> d >-- "path"
400
401 fromBEncode _ = decodingError "FileInfo"
402
403
404-- | Divide and round up.
405sizeInBase :: Integral a => a -> Int -> Int
406sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align
407 where
408 align = if n `mod` fromIntegral b == 0 then 0 else 1
409{-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}
410{-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
411
412
413-- | Find sum of sizes of the all torrent files.
414contentLength :: ContentInfo -> Integer
415contentLength SingleFile { ciLength = len } = len
416contentLength MultiFile { ciFiles = tfs } = sum (map fiLength tfs)
417
418-- | Get count of all files in torrent.
419fileCount :: ContentInfo -> Int
420fileCount SingleFile {..} = 1
421fileCount MultiFile {..} = length ciFiles
422
423-- | Find count of pieces in the torrent. If torrent size is not a
424-- multiple of piece size then the count is rounded up.
425pieceCount :: ContentInfo -> Int
426pieceCount ci = contentLength ci `sizeInBase` ciPieceLength ci
427
428-- | Find number of blocks of the specified size. If torrent size is
429-- not a multiple of block size then the count is rounded up.
430blockCount :: Int -- ^ Block size.
431 -> ContentInfo -- ^ Torrent content info.
432 -> Int -- ^ Number of blocks.
433blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
434
435-- | File layout specifies the order and the size of each file in the
436-- storage. Note that order of files is highly important since we
437-- coalesce all the files in the given order to get the linear block
438-- address space.
439--
440type Layout = [(FilePath, Int)]
441
442-- | Extract files layout from torrent info with the given root path.
443contentLayout :: FilePath -- ^ Root path for the all torrent files.
444 -> ContentInfo -- ^ Torrent content information.
445 -> Layout -- ^ The all file paths prefixed with the
446 -- given root.
447contentLayout rootPath = filesLayout
448 where
449 filesLayout (SingleFile { ciName = name, ciLength = len })
450 = [(rootPath </> BC.unpack name, fromIntegral len)]
451 filesLayout (MultiFile { ciFiles = fs, ciName = dir }) =
452 map (first mkPath . fl) fs
453 where -- TODO use utf8 encoding in name
454 mkPath = ((rootPath </> BC.unpack dir) </>) . joinPath . map BC.unpack
455
456 fl (FileInfo { fiPath = p, fiLength = len }) = (p, fromIntegral len)
457
458layoutOffsets :: Layout -> Layout
459layoutOffsets = go 0
460 where
461 go !_ [] = []
462 go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs
463
464-- | Gives global offset of a content file for a given full path.
465fileOffset :: FilePath -> ContentInfo -> Maybe Integer
466fileOffset fullPath
467 = fmap fromIntegral . lookup fullPath . layoutOffsets . contentLayout ""
468
469-- | Test if this is single file torrent.
470isSingleFile :: ContentInfo -> Bool
471isSingleFile SingleFile {} = True
472isSingleFile _ = False
473{-# INLINE isSingleFile #-}
474
475-- | Test if this is multifile torrent.
476isMultiFile :: ContentInfo -> Bool
477isMultiFile MultiFile {} = True
478isMultiFile _ = False
479{-# INLINE isMultiFile #-}
480
481slice :: Int -> Int -> ByteString -> ByteString
482slice from siz = B.take siz . B.drop from
483{-# INLINE slice #-}
484
485-- | Extract validation hash by specified piece index.
486pieceHash :: ContentInfo -> Int -> ByteString
487pieceHash ci ix = slice (hashsize * ix) hashsize (ciPieces ci)
488 where
489 hashsize = 20
490
491-- | Validate piece with metainfo hash.
492checkPiece :: ContentInfo -> Int -> ByteString -> Bool
493checkPiece ci ix piece
494 = B.length piece == ciPieceLength ci
495 && C.hash piece == pieceHash ci ix
496
497-- | Extension usually used for torrent metafiles.
498torrentExt :: String
499torrentExt = "torrent"
500
501-- | Test if this path has proper extension.
502isTorrentPath :: FilePath -> Bool
503isTorrentPath filepath = takeExtension filepath == extSeparator : torrentExt
504
505-- | Read and decode a .torrent file.
506fromFile :: FilePath -> IO Torrent
507fromFile filepath = do
508 contents <- B.readFile filepath
509 case decoded contents of
510 Right !t -> return t
511 Left msg -> throwIO $ userError $ msg ++ " while reading torrent" \ No newline at end of file
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 18:22:45 +0000