diff options
Diffstat (limited to 'src/Data/Torrent.hs')
-rw-r--r-- | src/Data/Torrent.hs | 270 |
1 files changed, 269 insertions, 1 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 5efff598..701da9dd 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -23,7 +23,11 @@ | |||
23 | {-# LANGUAGE MultiParamTypeClasses #-} | 23 | {-# LANGUAGE MultiParamTypeClasses #-} |
24 | {-# LANGUAGE BangPatterns #-} | 24 | {-# LANGUAGE BangPatterns #-} |
25 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 25 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
26 | {-# LANGUAGE StandaloneDeriving #-} | ||
26 | {-# LANGUAGE DeriveDataTypeable #-} | 27 | {-# LANGUAGE DeriveDataTypeable #-} |
28 | {-# LANGUAGE DeriveFunctor #-} | ||
29 | {-# LANGUAGE DeriveFoldable #-} | ||
30 | {-# LANGUAGE DeriveTraversable #-} | ||
27 | {-# LANGUAGE TemplateHaskell #-} | 31 | {-# LANGUAGE TemplateHaskell #-} |
28 | {-# OPTIONS -fno-warn-orphans #-} | 32 | {-# OPTIONS -fno-warn-orphans #-} |
29 | module Data.Torrent | 33 | module Data.Torrent |
@@ -51,6 +55,37 @@ module Data.Torrent | |||
51 | , parseURN | 55 | , parseURN |
52 | , renderURN | 56 | , renderURN |
53 | 57 | ||
58 | -- * File layout | ||
59 | -- ** FileInfo | ||
60 | , FileOffset | ||
61 | , FileSize | ||
62 | , FileInfo (..) | ||
63 | , fileLength | ||
64 | , filePath | ||
65 | , fileMD5Sum | ||
66 | |||
67 | -- ** Layout info | ||
68 | , LayoutInfo (..) | ||
69 | , joinFilePath | ||
70 | , singleFile | ||
71 | , multiFile | ||
72 | , rootDirName | ||
73 | , isSingleFile | ||
74 | , isMultiFile | ||
75 | , suggestedName | ||
76 | , contentLength | ||
77 | , fileCount | ||
78 | , blockCount | ||
79 | |||
80 | -- ** Flat layout info | ||
81 | , FileLayout | ||
82 | , flatLayout | ||
83 | , accumPositions | ||
84 | , fileOffset | ||
85 | |||
86 | -- ** Internal | ||
87 | , sizeInBase | ||
88 | |||
54 | -- * Info dictionary | 89 | -- * Info dictionary |
55 | , InfoDict (..) | 90 | , InfoDict (..) |
56 | , infoDictionary | 91 | , infoDictionary |
@@ -109,6 +144,7 @@ import qualified Data.ByteString.Lazy as BL | |||
109 | import Data.Char | 144 | import Data.Char |
110 | import Data.Convertible | 145 | import Data.Convertible |
111 | import Data.Default | 146 | import Data.Default |
147 | import Data.Foldable as F | ||
112 | import Data.Hashable as Hashable | 148 | import Data.Hashable as Hashable |
113 | import qualified Data.List as L | 149 | import qualified Data.List as L |
114 | import Data.Map as M | 150 | import Data.Map as M |
@@ -128,8 +164,8 @@ import Text.ParserCombinators.ReadP as P | |||
128 | import Text.PrettyPrint as PP | 164 | import Text.PrettyPrint as PP |
129 | import Text.PrettyPrint.Class | 165 | import Text.PrettyPrint.Class |
130 | import System.FilePath | 166 | import System.FilePath |
167 | import System.Posix.Types | ||
131 | 168 | ||
132 | import Data.Torrent.Layout | ||
133 | import Data.Torrent.Piece | 169 | import Data.Torrent.Piece |
134 | import Network.BitTorrent.Core.NodeInfo | 170 | import Network.BitTorrent.Core.NodeInfo |
135 | 171 | ||
@@ -259,6 +295,238 @@ shortHex :: InfoHash -> Text | |||
259 | shortHex = T.take 7 . longHex | 295 | shortHex = T.take 7 . longHex |
260 | 296 | ||
261 | {----------------------------------------------------------------------- | 297 | {----------------------------------------------------------------------- |
298 | -- File info | ||
299 | -----------------------------------------------------------------------} | ||
300 | |||
301 | -- | Size of a file in bytes. | ||
302 | type FileSize = FileOffset | ||
303 | |||
304 | deriving instance BEncode FileOffset | ||
305 | |||
306 | -- | Contain metainfo about one single file. | ||
307 | data FileInfo a = FileInfo { | ||
308 | fiLength :: {-# UNPACK #-} !FileSize | ||
309 | -- ^ Length of the file in bytes. | ||
310 | |||
311 | -- TODO unpacked MD5 sum | ||
312 | , fiMD5Sum :: !(Maybe ByteString) | ||
313 | -- ^ 32 character long MD5 sum of the file. Used by third-party | ||
314 | -- tools, not by bittorrent protocol itself. | ||
315 | |||
316 | , fiName :: !a | ||
317 | -- ^ One or more string elements that together represent the | ||
318 | -- path and filename. Each element in the list corresponds to | ||
319 | -- either a directory name or (in the case of the last element) | ||
320 | -- the filename. For example, the file: | ||
321 | -- | ||
322 | -- > "dir1/dir2/file.ext" | ||
323 | -- | ||
324 | -- would consist of three string elements: | ||
325 | -- | ||
326 | -- > ["dir1", "dir2", "file.ext"] | ||
327 | -- | ||
328 | } deriving (Show, Read, Eq, Typeable | ||
329 | , Functor, Foldable | ||
330 | ) | ||
331 | |||
332 | makeLensesFor | ||
333 | [ ("fiLength", "fileLength") | ||
334 | , ("fiMD5Sum", "fileMD5Sum") | ||
335 | , ("fiName" , "filePath" ) | ||
336 | ] | ||
337 | ''FileInfo | ||
338 | |||
339 | instance NFData a => NFData (FileInfo a) where | ||
340 | rnf FileInfo {..} = rnf fiName | ||
341 | {-# INLINE rnf #-} | ||
342 | |||
343 | instance BEncode (FileInfo [ByteString]) where | ||
344 | toBEncode FileInfo {..} = toDict $ | ||
345 | "length" .=! fiLength | ||
346 | .: "md5sum" .=? fiMD5Sum | ||
347 | .: "path" .=! fiName | ||
348 | .: endDict | ||
349 | {-# INLINE toBEncode #-} | ||
350 | |||
351 | fromBEncode = fromDict $ do | ||
352 | FileInfo <$>! "length" | ||
353 | <*>? "md5sum" | ||
354 | <*>! "path" | ||
355 | {-# INLINE fromBEncode #-} | ||
356 | |||
357 | type Put a = a -> BDict -> BDict | ||
358 | |||
359 | putFileInfoSingle :: Data.Torrent.Put (FileInfo ByteString) | ||
360 | putFileInfoSingle FileInfo {..} cont = | ||
361 | "length" .=! fiLength | ||
362 | .: "md5sum" .=? fiMD5Sum | ||
363 | .: "name" .=! fiName | ||
364 | .: cont | ||
365 | |||
366 | getFileInfoSingle :: BE.Get (FileInfo ByteString) | ||
367 | getFileInfoSingle = do | ||
368 | FileInfo <$>! "length" | ||
369 | <*>? "md5sum" | ||
370 | <*>! "name" | ||
371 | |||
372 | instance BEncode (FileInfo ByteString) where | ||
373 | toBEncode = toDict . (`putFileInfoSingle` endDict) | ||
374 | {-# INLINE toBEncode #-} | ||
375 | |||
376 | fromBEncode = fromDict getFileInfoSingle | ||
377 | {-# INLINE fromBEncode #-} | ||
378 | |||
379 | instance Pretty (FileInfo BS.ByteString) where | ||
380 | pretty FileInfo {..} = | ||
381 | "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) | ||
382 | $$ "Size: " <> text (show fiLength) | ||
383 | $$ maybe PP.empty ppMD5 fiMD5Sum | ||
384 | where | ||
385 | ppMD5 md5 = "MD5 : " <> text (show (Base16.encode md5)) | ||
386 | |||
387 | -- | Join file path. | ||
388 | joinFilePath :: FileInfo [ByteString] -> FileInfo ByteString | ||
389 | joinFilePath = fmap (BS.intercalate "/") | ||
390 | |||
391 | {----------------------------------------------------------------------- | ||
392 | -- Layout info | ||
393 | -----------------------------------------------------------------------} | ||
394 | |||
395 | -- | Original (found in torrent file) layout info is either: | ||
396 | -- | ||
397 | -- * Single file with its /name/. | ||
398 | -- | ||
399 | -- * Multiple files with its relative file /paths/. | ||
400 | -- | ||
401 | data LayoutInfo | ||
402 | = SingleFile | ||
403 | { -- | Single file info. | ||
404 | liFile :: !(FileInfo ByteString) | ||
405 | } | ||
406 | | MultiFile | ||
407 | { -- | List of the all files that torrent contains. | ||
408 | liFiles :: ![FileInfo [ByteString]] | ||
409 | |||
410 | -- | The /suggested/ name of the root directory in which to | ||
411 | -- store all the files. | ||
412 | , liDirName :: !ByteString | ||
413 | } deriving (Show, Read, Eq, Typeable) | ||
414 | |||
415 | makeLensesFor | ||
416 | [ ("liFile" , "singleFile" ) | ||
417 | , ("liFiles" , "multiFile" ) | ||
418 | , ("liDirName", "rootDirName") | ||
419 | ] | ||
420 | ''LayoutInfo | ||
421 | |||
422 | instance NFData LayoutInfo where | ||
423 | rnf SingleFile {..} = () | ||
424 | rnf MultiFile {..} = rnf liFiles | ||
425 | |||
426 | -- | Empty multifile layout. | ||
427 | instance Default LayoutInfo where | ||
428 | def = MultiFile [] "" | ||
429 | |||
430 | getLayoutInfo :: BE.Get LayoutInfo | ||
431 | getLayoutInfo = single <|> multi | ||
432 | where | ||
433 | single = SingleFile <$> getFileInfoSingle | ||
434 | multi = MultiFile <$>! "files" <*>! "name" | ||
435 | |||
436 | putLayoutInfo :: Data.Torrent.Put LayoutInfo | ||
437 | putLayoutInfo SingleFile {..} = putFileInfoSingle liFile | ||
438 | putLayoutInfo MultiFile {..} = \ cont -> | ||
439 | "files" .=! liFiles | ||
440 | .: "name" .=! liDirName | ||
441 | .: cont | ||
442 | |||
443 | instance BEncode LayoutInfo where | ||
444 | toBEncode = toDict . (`putLayoutInfo` endDict) | ||
445 | fromBEncode = fromDict getLayoutInfo | ||
446 | |||
447 | instance Pretty LayoutInfo where | ||
448 | pretty SingleFile {..} = pretty liFile | ||
449 | pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles | ||
450 | |||
451 | -- | Test if this is single file torrent. | ||
452 | isSingleFile :: LayoutInfo -> Bool | ||
453 | isSingleFile SingleFile {} = True | ||
454 | isSingleFile _ = False | ||
455 | {-# INLINE isSingleFile #-} | ||
456 | |||
457 | -- | Test if this is multifile torrent. | ||
458 | isMultiFile :: LayoutInfo -> Bool | ||
459 | isMultiFile MultiFile {} = True | ||
460 | isMultiFile _ = False | ||
461 | {-# INLINE isMultiFile #-} | ||
462 | |||
463 | -- | Get name of the torrent based on the root path piece. | ||
464 | suggestedName :: LayoutInfo -> ByteString | ||
465 | suggestedName (SingleFile FileInfo {..}) = fiName | ||
466 | suggestedName MultiFile {..} = liDirName | ||
467 | {-# INLINE suggestedName #-} | ||
468 | |||
469 | -- | Find sum of sizes of the all torrent files. | ||
470 | contentLength :: LayoutInfo -> FileSize | ||
471 | contentLength SingleFile { liFile = FileInfo {..} } = fiLength | ||
472 | contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs) | ||
473 | |||
474 | -- | Get number of all files in torrent. | ||
475 | fileCount :: LayoutInfo -> Int | ||
476 | fileCount SingleFile {..} = 1 | ||
477 | fileCount MultiFile {..} = L.length liFiles | ||
478 | |||
479 | -- | Find number of blocks of the specified size. If torrent size is | ||
480 | -- not a multiple of block size then the count is rounded up. | ||
481 | blockCount :: Int -> LayoutInfo -> Int | ||
482 | blockCount blkSize ci = contentLength ci `sizeInBase` blkSize | ||
483 | |||
484 | ------------------------------------------------------------------------ | ||
485 | |||
486 | -- | File layout specifies the order and the size of each file in the | ||
487 | -- storage. Note that order of files is highly important since we | ||
488 | -- coalesce all the files in the given order to get the linear block | ||
489 | -- address space. | ||
490 | -- | ||
491 | type FileLayout a = [(FilePath, a)] | ||
492 | |||
493 | -- | Extract files layout from torrent info with the given root path. | ||
494 | flatLayout | ||
495 | :: FilePath -- ^ Root path for the all torrent files. | ||
496 | -> LayoutInfo -- ^ Torrent content information. | ||
497 | -> FileLayout FileSize -- ^ The all file paths prefixed with the given root. | ||
498 | flatLayout prefixPath SingleFile { liFile = FileInfo {..} } | ||
499 | = [(prefixPath </> BC.unpack fiName, fiLength)] | ||
500 | flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles | ||
501 | where -- TODO use utf8 encoding in name | ||
502 | mkPath FileInfo {..} = (path, fiLength) | ||
503 | where | ||
504 | path = prefixPath </> BC.unpack liDirName | ||
505 | </> joinPath (L.map BC.unpack fiName) | ||
506 | |||
507 | -- | Calculate offset of each file based on its length, incrementally. | ||
508 | accumPositions :: FileLayout FileSize -> FileLayout (FileOffset, FileSize) | ||
509 | accumPositions = go 0 | ||
510 | where | ||
511 | go !_ [] = [] | ||
512 | go !offset ((n, s) : xs) = (n, (offset, s)) : go (offset + s) xs | ||
513 | |||
514 | -- | Gives global offset of a content file for a given full path. | ||
515 | fileOffset :: FilePath -> FileLayout FileOffset -> Maybe FileOffset | ||
516 | fileOffset = L.lookup | ||
517 | {-# INLINE fileOffset #-} | ||
518 | |||
519 | ------------------------------------------------------------------------ | ||
520 | |||
521 | -- | Divide and round up. | ||
522 | sizeInBase :: Integral a => a -> Int -> Int | ||
523 | sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align | ||
524 | where | ||
525 | align = if n `mod` fromIntegral b == 0 then 0 else 1 | ||
526 | {-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-} | ||
527 | {-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-} | ||
528 | |||
529 | {----------------------------------------------------------------------- | ||
262 | -- Info dictionary | 530 | -- Info dictionary |
263 | -----------------------------------------------------------------------} | 531 | -----------------------------------------------------------------------} |
264 | 532 | ||