summaryrefslogtreecommitdiff
path: root/src/Data/Torrent.hs
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-04-26 07:42:57 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-04-26 07:42:57 +0400
commita7fda9d39ed82cb9d3ad0c28e76e88e59539a492 (patch)
tree925183a691bbb57ca5f7140614e1fdbc610b3b1e /src/Data/Torrent.hs
parent4587ffd5406162bb06a6549ffd2ff277e0a93916 (diff)
parent85bf8475bbbce79b1bedde641192fa945614283d (diff)
Merge branch 'tidy' into dev
Diffstat (limited to 'src/Data/Torrent.hs')
-rw-r--r--src/Data/Torrent.hs989
1 files changed, 955 insertions, 34 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index b233937b..cfc26453 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -17,23 +17,91 @@
17-- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure> 17-- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure>
18-- 18--
19{-# LANGUAGE CPP #-} 19{-# LANGUAGE CPP #-}
20{-# LANGUAGE NamedFieldPuns #-}
20{-# LANGUAGE FlexibleInstances #-} 21{-# LANGUAGE FlexibleInstances #-}
21{-# LANGUAGE OverlappingInstances #-} 22{-# LANGUAGE OverlappingInstances #-}
23{-# LANGUAGE MultiParamTypeClasses #-}
22{-# LANGUAGE BangPatterns #-} 24{-# LANGUAGE BangPatterns #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-} 25{-# LANGUAGE GeneralizedNewtypeDeriving #-}
26{-# LANGUAGE StandaloneDeriving #-}
24{-# LANGUAGE DeriveDataTypeable #-} 27{-# LANGUAGE DeriveDataTypeable #-}
28{-# LANGUAGE DeriveFunctor #-}
29{-# LANGUAGE DeriveFoldable #-}
30{-# LANGUAGE DeriveTraversable #-}
25{-# LANGUAGE TemplateHaskell #-} 31{-# LANGUAGE TemplateHaskell #-}
26{-# OPTIONS -fno-warn-orphans #-} 32{-# OPTIONS -fno-warn-orphans #-}
27module Data.Torrent 33module Data.Torrent
28 ( -- * Info dictionary 34 ( -- * InfoHash
29 InfoDict (..) 35 -- $infohash
30 , infoDictionary 36 InfoHash
37 , textToInfoHash
38 , longHex
39 , shortHex
31 40
32 -- ** Lenses 41 -- * File layout
42 -- ** FileInfo
43 , FileOffset
44 , FileSize
45 , FileInfo (..)
46 , fileLength
47 , filePath
48 , fileMD5Sum
49
50 -- ** Layout info
51 , LayoutInfo (..)
52 , singleFile
53 , multiFile
54 , rootDirName
55 , joinFilePath
56 , isSingleFile
57 , isMultiFile
58 , suggestedName
59 , contentLength
60 , fileCount
61 , blockCount
62
63 -- ** Flat layout info
64 , FileLayout
65 , flatLayout
66 , accumPositions
67 , fileOffset
68
69 -- ** Internal
70 , sizeInBase
71
72 -- * Pieces
73 -- ** Attributes
74 , PieceIx
75 , PieceCount
76 , PieceSize
77 , minPieceSize
78 , maxPieceSize
79 , defaultPieceSize
80 , PieceHash
81
82 -- ** Piece data
83 , Piece (..)
84 , pieceSize
85 , hashPiece
86
87 -- ** Piece control
88 , HashList (..)
89 , PieceInfo (..)
90 , pieceLength
91 , pieceHashes
92 , pieceCount
93
94 -- ** Validation
95 , pieceHash
96 , checkPieceLazy
97
98 -- * Info dictionary
99 , InfoDict (..)
33 , infohash 100 , infohash
34 , layoutInfo 101 , layoutInfo
35 , pieceInfo 102 , pieceInfo
36 , isPrivate 103 , isPrivate
104 , infoDictionary
37 105
38 -- * Torrent file 106 -- * Torrent file
39 , Torrent(..) 107 , Torrent(..)
@@ -50,50 +118,598 @@ module Data.Torrent
50 , publisherURL 118 , publisherURL
51 , signature 119 , signature
52 120
53 -- * Construction 121 -- ** Utils
54 , nullTorrent 122 , nullTorrent
55
56 -- * Mime types
57 , typeTorrent 123 , typeTorrent
58
59 -- * File paths
60 , torrentExt 124 , torrentExt
61 , isTorrentPath 125 , isTorrentPath
62
63 -- * IO
64 , fromFile 126 , fromFile
65 , toFile 127 , toFile
128
129 -- * Magnet
130 -- $magnet-link
131 , Magnet(..)
132 , nullMagnet
133 , simpleMagnet
134 , detailedMagnet
135 , parseMagnet
136 , renderMagnet
137
138 -- ** URN
139 , URN (..)
140 , NamespaceId
141 , btih
142 , infohashURN
143 , parseURN
144 , renderURN
66 ) where 145 ) where
67 146
68import Prelude hiding (sum) 147import Prelude
69import Control.Applicative 148import Control.Applicative
70import qualified Crypto.Hash.SHA1 as C
71import Control.DeepSeq 149import Control.DeepSeq
72import Control.Exception 150import Control.Exception
73import Control.Lens 151import Control.Lens
152import Control.Monad
153import Crypto.Hash.SHA1 as SHA1
74import Data.BEncode as BE 154import Data.BEncode as BE
75import Data.BEncode.Types as BE 155import Data.BEncode.Types as BE
76import Data.ByteString as BS 156import Data.Bits
77import qualified Data.ByteString.Char8 as BC (pack, unpack) 157import Data.Bits.Extras
78import qualified Data.ByteString.Lazy as BL 158import Data.ByteString as BS
79import Data.Convertible 159import Data.ByteString.Base16 as Base16
80import Data.Default 160import Data.ByteString.Base32 as Base32
81import Data.Hashable as Hashable 161import Data.ByteString.Base64 as Base64
82import qualified Data.List as L 162import Data.ByteString.Char8 as BC (pack, unpack)
83import Data.Text as T 163import Data.ByteString.Lazy as BL
84import Data.Time 164import Data.Char
165import Data.Convertible
166import Data.Default
167import Data.Foldable as F
168import Data.Hashable as Hashable
169import Data.Int
170import Data.List as L
171import Data.Map as M
172import Data.Maybe
173import Data.Serialize as S
174import Data.String
175import Data.Text as T
176import Data.Text.Encoding as T
177import Data.Text.Read
85import Data.Time.Clock.POSIX 178import Data.Time.Clock.POSIX
86import Data.Typeable 179import Data.Typeable
87import Network (HostName) 180import Network (HostName)
181import Network.HTTP.Types.QueryLike
182import Network.HTTP.Types.URI
88import Network.URI 183import Network.URI
184import Text.ParserCombinators.ReadP as P
89import Text.PrettyPrint as PP 185import Text.PrettyPrint as PP
90import Text.PrettyPrint.Class 186import Text.PrettyPrint.Class
91import System.FilePath 187import System.FilePath
188import System.Posix.Types
189
190import Network.BitTorrent.Address
191
192
193{-----------------------------------------------------------------------
194-- Info hash
195-----------------------------------------------------------------------}
196-- TODO
197--
198-- data Word160 = Word160 {-# UNPACK #-} !Word64
199-- {-# UNPACK #-} !Word64
200-- {-# UNPACK #-} !Word32
201--
202-- newtype InfoHash = InfoHash Word160
203--
204-- reason: bytestring have overhead = 8 words, while infohash have length 20 bytes
205
206-- $infohash
207--
208-- Infohash is a unique identifier of torrent.
209
210-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
211newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
212 deriving (Eq, Ord, Typeable)
213
214infoHashLen :: Int
215infoHashLen = 20
216
217-- | Meaningless placeholder value.
218instance Default InfoHash where
219 def = "0123456789012345678901234567890123456789"
220
221-- | Hash raw bytes. (no encoding)
222instance Hashable InfoHash where
223 hashWithSalt s (InfoHash ih) = hashWithSalt s ih
224 {-# INLINE hashWithSalt #-}
225
226-- | Convert to\/from raw bencoded string. (no encoding)
227instance BEncode InfoHash where
228 toBEncode = toBEncode . getInfoHash
229 fromBEncode be = InfoHash <$> fromBEncode be
230
231-- | Convert to\/from raw bytestring. (no encoding)
232instance Serialize InfoHash where
233 put (InfoHash ih) = putByteString ih
234 {-# INLINE put #-}
235
236 get = InfoHash <$> getBytes infoHashLen
237 {-# INLINE get #-}
238
239-- | Convert to raw query value. (no encoding)
240instance QueryValueLike InfoHash where
241 toQueryValue (InfoHash ih) = Just ih
242 {-# INLINE toQueryValue #-}
243
244-- | Convert to base16 encoded string.
245instance Show InfoHash where
246 show (InfoHash ih) = BC.unpack (Base16.encode ih)
247
248-- | Convert to base16 encoded Doc string.
249instance Pretty InfoHash where
250 pretty = text . show
251
252-- | Read base16 encoded string.
253instance Read InfoHash where
254 readsPrec _ = readP_to_S $ do
255 str <- replicateM (infoHashLen * 2) (satisfy isHexDigit)
256 return $ InfoHash $ decodeIH str
257 where
258 decodeIH = BS.pack . L.map fromHex . pair
259 fromHex (a, b) = read $ '0' : 'x' : a : b : []
260
261 pair (a : b : xs) = (a, b) : pair xs
262 pair _ = []
263
264-- | Convert raw bytes to info hash.
265instance Convertible BS.ByteString InfoHash where
266 safeConvert bs
267 | BS.length bs == infoHashLen = pure (InfoHash bs)
268 | otherwise = convError "invalid length" bs
269
270-- | Parse infohash from base16\/base32\/base64 encoded string.
271instance Convertible Text InfoHash where
272 safeConvert t
273 | 20 == hashLen = pure (InfoHash hashStr)
274 | 26 <= hashLen && hashLen <= 28 =
275 case Base64.decode hashStr of
276 Left msg -> convError ("invalid base64 encoding " ++ msg) t
277 Right ihStr -> safeConvert ihStr
278
279 | hashLen == 32 =
280 case Base32.decode hashStr of
281 Left msg -> convError msg t
282 Right ihStr -> safeConvert ihStr
283
284 | hashLen == 40 =
285 let (ihStr, inv) = Base16.decode hashStr
286 in if BS.length inv /= 0
287 then convError "invalid base16 encoding" t
288 else safeConvert ihStr
289
290 | otherwise = convError "invalid length" t
291 where
292 hashLen = BS.length hashStr
293 hashStr = T.encodeUtf8 t
294
295-- | Decode from base16\/base32\/base64 encoded string.
296instance IsString InfoHash where
297 fromString = either (error . prettyConvertError) id . safeConvert . T.pack
298
299ignoreErrorMsg :: Either a b -> Maybe b
300ignoreErrorMsg = either (const Nothing) Just
301
302-- | Tries both base16 and base32 while decoding info hash.
303--
304-- Use 'safeConvert' for detailed error messages.
305--
306textToInfoHash :: Text -> Maybe InfoHash
307textToInfoHash = ignoreErrorMsg . safeConvert
92 308
93import Data.Torrent.InfoHash as IH 309-- | Hex encode infohash to text, full length.
94import Data.Torrent.Layout 310longHex :: InfoHash -> Text
95import Data.Torrent.Piece 311longHex = T.decodeUtf8 . Base16.encode . getInfoHash
96import Network.BitTorrent.Core.NodeInfo 312
313-- | The same as 'longHex', but only first 7 characters.
314shortHex :: InfoHash -> Text
315shortHex = T.take 7 . longHex
316
317{-----------------------------------------------------------------------
318-- File info
319-----------------------------------------------------------------------}
320
321-- | Size of a file in bytes.
322type FileSize = FileOffset
323
324deriving instance BEncode FileOffset
325
326-- | Contain metainfo about one single file.
327data FileInfo a = FileInfo {
328 fiLength :: {-# UNPACK #-} !FileSize
329 -- ^ Length of the file in bytes.
330
331 -- TODO unpacked MD5 sum
332 , fiMD5Sum :: !(Maybe BS.ByteString)
333 -- ^ 32 character long MD5 sum of the file. Used by third-party
334 -- tools, not by bittorrent protocol itself.
335
336 , fiName :: !a
337 -- ^ One or more string elements that together represent the
338 -- path and filename. Each element in the list corresponds to
339 -- either a directory name or (in the case of the last element)
340 -- the filename. For example, the file:
341 --
342 -- > "dir1/dir2/file.ext"
343 --
344 -- would consist of three string elements:
345 --
346 -- > ["dir1", "dir2", "file.ext"]
347 --
348 } deriving (Show, Read, Eq, Typeable
349 , Functor, Foldable
350 )
351
352makeLensesFor
353 [ ("fiLength", "fileLength")
354 , ("fiMD5Sum", "fileMD5Sum")
355 , ("fiName" , "filePath" )
356 ]
357 ''FileInfo
358
359instance NFData a => NFData (FileInfo a) where
360 rnf FileInfo {..} = rnf fiName
361 {-# INLINE rnf #-}
362
363instance BEncode (FileInfo [BS.ByteString]) where
364 toBEncode FileInfo {..} = toDict $
365 "length" .=! fiLength
366 .: "md5sum" .=? fiMD5Sum
367 .: "path" .=! fiName
368 .: endDict
369 {-# INLINE toBEncode #-}
370
371 fromBEncode = fromDict $ do
372 FileInfo <$>! "length"
373 <*>? "md5sum"
374 <*>! "path"
375 {-# INLINE fromBEncode #-}
376
377type Put a = a -> BDict -> BDict
378
379putFileInfoSingle :: Data.Torrent.Put (FileInfo BS.ByteString)
380putFileInfoSingle FileInfo {..} cont =
381 "length" .=! fiLength
382 .: "md5sum" .=? fiMD5Sum
383 .: "name" .=! fiName
384 .: cont
385
386getFileInfoSingle :: BE.Get (FileInfo BS.ByteString)
387getFileInfoSingle = do
388 FileInfo <$>! "length"
389 <*>? "md5sum"
390 <*>! "name"
391
392instance BEncode (FileInfo BS.ByteString) where
393 toBEncode = toDict . (`putFileInfoSingle` endDict)
394 {-# INLINE toBEncode #-}
395
396 fromBEncode = fromDict getFileInfoSingle
397 {-# INLINE fromBEncode #-}
398
399instance Pretty (FileInfo BS.ByteString) where
400 pretty FileInfo {..} =
401 "Path: " <> text (T.unpack (T.decodeUtf8 fiName))
402 $$ "Size: " <> text (show fiLength)
403 $$ maybe PP.empty ppMD5 fiMD5Sum
404 where
405 ppMD5 md5 = "MD5 : " <> text (show (Base16.encode md5))
406
407-- | Join file path.
408joinFilePath :: FileInfo [BS.ByteString] -> FileInfo BS.ByteString
409joinFilePath = fmap (BS.intercalate "/")
410
411{-----------------------------------------------------------------------
412-- Layout info
413-----------------------------------------------------------------------}
414
415-- | Original (found in torrent file) layout info is either:
416--
417-- * Single file with its /name/.
418--
419-- * Multiple files with its relative file /paths/.
420--
421data LayoutInfo
422 = SingleFile
423 { -- | Single file info.
424 liFile :: !(FileInfo BS.ByteString)
425 }
426 | MultiFile
427 { -- | List of the all files that torrent contains.
428 liFiles :: ![FileInfo [BS.ByteString]]
429
430 -- | The /suggested/ name of the root directory in which to
431 -- store all the files.
432 , liDirName :: !BS.ByteString
433 } deriving (Show, Read, Eq, Typeable)
434
435makeLensesFor
436 [ ("liFile" , "singleFile" )
437 , ("liFiles" , "multiFile" )
438 , ("liDirName", "rootDirName")
439 ]
440 ''LayoutInfo
441
442instance NFData LayoutInfo where
443 rnf SingleFile {..} = ()
444 rnf MultiFile {..} = rnf liFiles
445
446-- | Empty multifile layout.
447instance Default LayoutInfo where
448 def = MultiFile [] ""
449
450getLayoutInfo :: BE.Get LayoutInfo
451getLayoutInfo = single <|> multi
452 where
453 single = SingleFile <$> getFileInfoSingle
454 multi = MultiFile <$>! "files" <*>! "name"
455
456putLayoutInfo :: Data.Torrent.Put LayoutInfo
457putLayoutInfo SingleFile {..} = putFileInfoSingle liFile
458putLayoutInfo MultiFile {..} = \ cont ->
459 "files" .=! liFiles
460 .: "name" .=! liDirName
461 .: cont
462
463instance BEncode LayoutInfo where
464 toBEncode = toDict . (`putLayoutInfo` endDict)
465 fromBEncode = fromDict getLayoutInfo
466
467instance Pretty LayoutInfo where
468 pretty SingleFile {..} = pretty liFile
469 pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles
470
471-- | Test if this is single file torrent.
472isSingleFile :: LayoutInfo -> Bool
473isSingleFile SingleFile {} = True
474isSingleFile _ = False
475{-# INLINE isSingleFile #-}
476
477-- | Test if this is multifile torrent.
478isMultiFile :: LayoutInfo -> Bool
479isMultiFile MultiFile {} = True
480isMultiFile _ = False
481{-# INLINE isMultiFile #-}
482
483-- | Get name of the torrent based on the root path piece.
484suggestedName :: LayoutInfo -> BS.ByteString
485suggestedName (SingleFile FileInfo {..}) = fiName
486suggestedName MultiFile {..} = liDirName
487{-# INLINE suggestedName #-}
488
489-- | Find sum of sizes of the all torrent files.
490contentLength :: LayoutInfo -> FileSize
491contentLength SingleFile { liFile = FileInfo {..} } = fiLength
492contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs)
493
494-- | Get number of all files in torrent.
495fileCount :: LayoutInfo -> Int
496fileCount SingleFile {..} = 1
497fileCount MultiFile {..} = L.length liFiles
498
499-- | Find number of blocks of the specified size. If torrent size is
500-- not a multiple of block size then the count is rounded up.
501blockCount :: Int -> LayoutInfo -> Int
502blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
503
504------------------------------------------------------------------------
505
506-- | File layout specifies the order and the size of each file in the
507-- storage. Note that order of files is highly important since we
508-- coalesce all the files in the given order to get the linear block
509-- address space.
510--
511type FileLayout a = [(FilePath, a)]
512
513-- | Extract files layout from torrent info with the given root path.
514flatLayout
515 :: FilePath -- ^ Root path for the all torrent files.
516 -> LayoutInfo -- ^ Torrent content information.
517 -> FileLayout FileSize -- ^ The all file paths prefixed with the given root.
518flatLayout prefixPath SingleFile { liFile = FileInfo {..} }
519 = [(prefixPath </> BC.unpack fiName, fiLength)]
520flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles
521 where -- TODO use utf8 encoding in name
522 mkPath FileInfo {..} = (_path, fiLength)
523 where
524 _path = prefixPath </> BC.unpack liDirName
525 </> joinPath (L.map BC.unpack fiName)
526
527-- | Calculate offset of each file based on its length, incrementally.
528accumPositions :: FileLayout FileSize -> FileLayout (FileOffset, FileSize)
529accumPositions = go 0
530 where
531 go !_ [] = []
532 go !offset ((n, s) : xs) = (n, (offset, s)) : go (offset + s) xs
533
534-- | Gives global offset of a content file for a given full path.
535fileOffset :: FilePath -> FileLayout FileOffset -> Maybe FileOffset
536fileOffset = L.lookup
537{-# INLINE fileOffset #-}
538
539------------------------------------------------------------------------
540
541-- | Divide and round up.
542sizeInBase :: Integral a => a -> Int -> Int
543sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align
544 where
545 align = if n `mod` fromIntegral b == 0 then 0 else 1
546{-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}
547{-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
548
549{-----------------------------------------------------------------------
550-- Piece attributes
551-----------------------------------------------------------------------}
552
553-- | Zero-based index of piece in torrent content.
554type PieceIx = Int
555
556-- | Size of piece in bytes. Should be a power of 2.
557--
558-- NOTE: Have max and min size constrained to wide used
559-- semi-standard values. This bounds should be used to make decision
560-- about piece size for new torrents.
561--
562type PieceSize = Int
563
564-- | Number of pieces in torrent or a part of torrent.
565type PieceCount = Int
566
567defaultBlockSize :: Int
568defaultBlockSize = 16 * 1024
569
570-- | Optimal number of pieces in torrent.
571optimalPieceCount :: PieceCount
572optimalPieceCount = 1000
573{-# INLINE optimalPieceCount #-}
574
575-- | Piece size should not be less than this value.
576minPieceSize :: Int
577minPieceSize = defaultBlockSize * 4
578{-# INLINE minPieceSize #-}
579
580-- | To prevent transfer degradation piece size should not exceed this
581-- value.
582maxPieceSize :: Int
583maxPieceSize = 4 * 1024 * 1024
584{-# INLINE maxPieceSize #-}
585
586toPow2 :: Int -> Int
587toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)
588
589-- | Find the optimal piece size for a given torrent size.
590defaultPieceSize :: Int64 -> Int
591defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc
592 where
593 pc = fromIntegral (x `div` fromIntegral optimalPieceCount)
594
595{-----------------------------------------------------------------------
596-- Piece data
597-----------------------------------------------------------------------}
598
599type PieceHash = BS.ByteString
600
601hashsize :: Int
602hashsize = 20
603{-# INLINE hashsize #-}
604
605-- TODO check if pieceLength is power of 2
606-- | Piece payload should be strict or lazy bytestring.
607data Piece a = Piece
608 { -- | Zero-based piece index in torrent.
609 pieceIndex :: {-# UNPACK #-} !PieceIx
610
611 -- | Payload.
612 , pieceData :: !a
613 } deriving (Show, Read, Eq, Functor, Typeable)
614
615instance NFData (Piece a)
616
617-- | Payload bytes are omitted.
618instance Pretty (Piece a) where
619 pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
620
621-- | Get size of piece in bytes.
622pieceSize :: Piece BL.ByteString -> PieceSize
623pieceSize Piece {..} = fromIntegral (BL.length pieceData)
624
625-- | Get piece hash.
626hashPiece :: Piece BL.ByteString -> PieceHash
627hashPiece Piece {..} = SHA1.hashlazy pieceData
628
629{-----------------------------------------------------------------------
630-- Piece control
631-----------------------------------------------------------------------}
632
633-- | A flat array of SHA1 hash for each piece.
634newtype HashList = HashList { unHashList :: BS.ByteString }
635 deriving (Show, Read, Eq, BEncode, Typeable)
636
637-- | Empty hash list.
638instance Default HashList where
639 def = HashList ""
640
641-- | Part of torrent file used for torrent content validation.
642data PieceInfo = PieceInfo
643 { piPieceLength :: {-# UNPACK #-} !PieceSize
644 -- ^ Number of bytes in each piece.
645
646 , piPieceHashes :: !HashList
647 -- ^ Concatenation of all 20-byte SHA1 hash values.
648 } deriving (Show, Read, Eq, Typeable)
649
650-- | Number of bytes in each piece.
651makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
652
653-- | Concatenation of all 20-byte SHA1 hash values.
654makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo
655
656instance NFData PieceInfo
657
658instance Default PieceInfo where
659 def = PieceInfo 1 def
660
661class Lint a where
662 lint :: a -> Either String a
663
664instance Lint PieceInfo where
665 lint pinfo @ PieceInfo {..}
666 | BS.length (unHashList piPieceHashes) `rem` hashsize == 0
667 , piPieceLength >= 0 = return pinfo
668 | otherwise = Left undefined
669
670
671putPieceInfo :: Data.Torrent.Put PieceInfo
672putPieceInfo PieceInfo {..} cont =
673 "piece length" .=! piPieceLength
674 .: "pieces" .=! piPieceHashes
675 .: cont
676
677getPieceInfo :: BE.Get PieceInfo
678getPieceInfo = do
679 PieceInfo <$>! "piece length"
680 <*>! "pieces"
681
682instance BEncode PieceInfo where
683 toBEncode = toDict . (`putPieceInfo` endDict)
684 fromBEncode = fromDict getPieceInfo
685
686-- | Hashes are omitted.
687instance Pretty PieceInfo where
688 pretty PieceInfo {..} = "Piece size: " <> int piPieceLength
689
690slice :: Int -> Int -> BS.ByteString -> BS.ByteString
691slice start len = BS.take len . BS.drop start
692{-# INLINE slice #-}
693
694-- | Extract validation hash by specified piece index.
695pieceHash :: PieceInfo -> PieceIx -> PieceHash
696pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashList piPieceHashes)
697
698-- | Find count of pieces in the torrent. If torrent size is not a
699-- multiple of piece size then the count is rounded up.
700pieceCount :: PieceInfo -> PieceCount
701pieceCount PieceInfo {..} = BS.length (unHashList piPieceHashes) `quot` hashsize
702
703-- | Test if this is last piece in torrent content.
704isLastPiece :: PieceInfo -> PieceIx -> Bool
705isLastPiece ci i = pieceCount ci == succ i
706
707-- | Validate piece with metainfo hash.
708checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool
709checkPieceLazy pinfo @ PieceInfo {..} Piece {..}
710 = (fromIntegral (BL.length pieceData) == piPieceLength
711 || isLastPiece pinfo pieceIndex)
712 && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
97 713
98{----------------------------------------------------------------------- 714{-----------------------------------------------------------------------
99-- Info dictionary 715-- Info dictionary
@@ -145,9 +761,9 @@ instance Default InfoDict where
145infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict 761infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict
146infoDictionary li pinfo private = InfoDict ih li pinfo private 762infoDictionary li pinfo private = InfoDict ih li pinfo private
147 where 763 where
148 ih = hashLazyIH $ encode $ InfoDict def li pinfo private 764 ih = hashLazyIH $ BE.encode $ InfoDict def li pinfo private
149 765
150getPrivate :: Get Bool 766getPrivate :: BE.Get Bool
151getPrivate = (Just True ==) <$>? "private" 767getPrivate = (Just True ==) <$>? "private"
152 768
153putPrivate :: Bool -> BDict -> BDict 769putPrivate :: Bool -> BDict -> BDict
@@ -156,7 +772,7 @@ putPrivate True = \ cont -> "private" .=! True .: cont
156 772
157-- | Hash lazy bytestring using SHA1 algorithm. 773-- | Hash lazy bytestring using SHA1 algorithm.
158hashLazyIH :: BL.ByteString -> InfoHash 774hashLazyIH :: BL.ByteString -> InfoHash
159hashLazyIH = either (const (error msg)) id . safeConvert . C.hashlazy 775hashLazyIH = either (const (error msg)) id . safeConvert . SHA1.hashlazy
160 where 776 where
161 msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long" 777 msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long"
162 778
@@ -172,7 +788,7 @@ instance BEncode InfoDict where
172 <*> getPieceInfo 788 <*> getPieceInfo
173 <*> getPrivate 789 <*> getPrivate
174 where 790 where
175 ih = hashLazyIH (encode dict) 791 ih = hashLazyIH (BE.encode dict)
176 792
177ppPrivacy :: Bool -> Doc 793ppPrivacy :: Bool -> Doc
178ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public" 794ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public"
@@ -189,6 +805,7 @@ instance Pretty InfoDict where
189{----------------------------------------------------------------------- 805{-----------------------------------------------------------------------
190-- Torrent info 806-- Torrent info
191-----------------------------------------------------------------------} 807-----------------------------------------------------------------------}
808-- TODO add torrent file validation
192 809
193-- | Metainfo about particular torrent. 810-- | Metainfo about particular torrent.
194data Torrent = Torrent 811data Torrent = Torrent
@@ -219,7 +836,7 @@ data Torrent = Torrent
219 , tNodes :: !(Maybe [NodeAddr HostName]) 836 , tNodes :: !(Maybe [NodeAddr HostName])
220 -- ^ This key should be set to the /K closest/ nodes in the 837 -- ^ This key should be set to the /K closest/ nodes in the
221 -- torrent generating client's routing table. Alternatively, the 838 -- torrent generating client's routing table. Alternatively, the
222 -- key could be set to a known good 'Network.BitTorrent.Core.Node' 839 -- key could be set to a known good 'Network.BitTorrent.Address.Node'
223 -- such as one operated by the person generating the torrent. 840 -- such as one operated by the person generating the torrent.
224 -- 841 --
225 -- Please do not automatically add \"router.bittorrent.com\" to 842 -- Please do not automatically add \"router.bittorrent.com\" to
@@ -232,7 +849,7 @@ data Torrent = Torrent
232 -- authority to allow new peers onto the swarm. 849 -- authority to allow new peers onto the swarm.
233 850
234 , tPublisherURL :: !(Maybe URI) 851 , tPublisherURL :: !(Maybe URI)
235 , tSignature :: !(Maybe ByteString) 852 , tSignature :: !(Maybe BS.ByteString)
236 -- ^ The RSA signature of the info dictionary (specifically, the 853 -- ^ The RSA signature of the info dictionary (specifically, the
237 -- encrypted SHA-1 hash of the info dictionary). 854 -- encrypted SHA-1 hash of the info dictionary).
238 } deriving (Show, Eq, Typeable) 855 } deriving (Show, Eq, Typeable)
@@ -361,10 +978,314 @@ isTorrentPath filepath = takeExtension filepath == extSeparator : torrentExt
361fromFile :: FilePath -> IO Torrent 978fromFile :: FilePath -> IO Torrent
362fromFile filepath = do 979fromFile filepath = do
363 contents <- BS.readFile filepath 980 contents <- BS.readFile filepath
364 case decode contents of 981 case BE.decode contents of
365 Right !t -> return t 982 Right !t -> return t
366 Left msg -> throwIO $ userError $ msg ++ " while reading torrent file" 983 Left msg -> throwIO $ userError $ msg ++ " while reading torrent file"
367 984
368-- | Encode and write a .torrent file. 985-- | Encode and write a .torrent file.
369toFile :: FilePath -> Torrent -> IO () 986toFile :: FilePath -> Torrent -> IO ()
370toFile filepath = BL.writeFile filepath . encode 987toFile filepath = BL.writeFile filepath . BE.encode
988
989{-----------------------------------------------------------------------
990-- URN
991-----------------------------------------------------------------------}
992
993-- | Namespace identifier determines the syntactic interpretation of
994-- namespace-specific string.
995type NamespaceId = [Text]
996
997-- | BitTorrent Info Hash (hence the name) namespace
998-- identifier. Namespace-specific string /should/ be a base16\/base32
999-- encoded SHA1 hash of the corresponding torrent /info/ dictionary.
1000--
1001btih :: NamespaceId
1002btih = ["btih"]
1003
1004-- | URN is pesistent location-independent identifier for
1005-- resources. In particular, URNs are used represent torrent names
1006-- as a part of magnet link, see 'Data.Torrent.Magnet.Magnet' for
1007-- more info.
1008--
1009data URN = URN
1010 { urnNamespace :: NamespaceId -- ^ a namespace identifier;
1011 , urnString :: Text -- ^ a corresponding
1012 -- namespace-specific string.
1013 } deriving (Eq, Ord, Typeable)
1014
1015-----------------------------------------------------------------------
1016
1017instance Convertible URN InfoHash where
1018 safeConvert u @ URN {..}
1019 | urnNamespace /= btih = convError "invalid namespace" u
1020 | otherwise = safeConvert urnString
1021
1022-- | Make resource name for torrent with corresponding
1023-- infohash. Infohash is base16 (hex) encoded.
1024--
1025infohashURN :: InfoHash -> URN
1026infohashURN = URN btih . longHex
1027
1028-- | Meaningless placeholder value.
1029instance Default URN where
1030 def = infohashURN def
1031
1032------------------------------------------------------------------------
1033
1034-- | Render URN to its text representation.
1035renderURN :: URN -> Text
1036renderURN URN {..}
1037 = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]
1038
1039instance Pretty URN where
1040 pretty = text . T.unpack . renderURN
1041
1042instance Show URN where
1043 showsPrec n = showsPrec n . T.unpack . renderURN
1044
1045instance QueryValueLike URN where
1046 toQueryValue = toQueryValue . renderURN
1047 {-# INLINE toQueryValue #-}
1048
1049-----------------------------------------------------------------------
1050
1051_unsnoc :: [a] -> Maybe ([a], a)
1052_unsnoc [] = Nothing
1053_unsnoc xs = Just (L.init xs, L.last xs)
1054
1055instance Convertible Text URN where
1056 safeConvert t = case T.split (== ':') t of
1057 uriScheme : body
1058 | T.toLower uriScheme == "urn" ->
1059 case _unsnoc body of
1060 Just (namespace, val) -> pure URN
1061 { urnNamespace = namespace
1062 , urnString = val
1063 }
1064 Nothing -> convError "missing URN string" body
1065 | otherwise -> convError "invalid URN scheme" uriScheme
1066 [] -> convError "missing URN scheme" t
1067
1068instance IsString URN where
1069 fromString = either (error . prettyConvertError) id
1070 . safeConvert . T.pack
1071
1072-- | Try to parse an URN from its text representation.
1073--
1074-- Use 'safeConvert' for detailed error messages.
1075--
1076parseURN :: Text -> Maybe URN
1077parseURN = either (const Nothing) pure . safeConvert
1078
1079{-----------------------------------------------------------------------
1080-- Magnet
1081-----------------------------------------------------------------------}
1082-- $magnet-link
1083--
1084-- Magnet URI scheme is an standard defining Magnet links. Magnet
1085-- links are refer to resources by hash, in particular magnet links
1086-- can refer to torrent using corresponding infohash. In this way,
1087-- magnet links can be used instead of torrent files.
1088--
1089-- This module provides bittorrent specific implementation of magnet
1090-- links.
1091--
1092-- For generic magnet uri scheme see:
1093-- <http://magnet-uri.sourceforge.net/magnet-draft-overview.txt>,
1094-- <http://www.iana.org/assignments/uri-schemes/prov/magnet>
1095--
1096-- Bittorrent specific details:
1097-- <http://www.bittorrent.org/beps/bep_0009.html>
1098--
1099
1100-- TODO multiple exact topics
1101-- TODO render/parse supplement for URI/query
1102
1103-- | An URI used to identify torrent.
1104data Magnet = Magnet
1105 { -- | Torrent infohash hash. Can be used in DHT queries if no
1106 -- 'tracker' provided.
1107 exactTopic :: !InfoHash -- TODO InfoHash -> URN?
1108
1109 -- | A filename for the file to download. Can be used to
1110 -- display name while waiting for metadata.
1111 , displayName :: Maybe Text
1112
1113 -- | Size of the resource in bytes.
1114 , exactLength :: Maybe Integer
1115
1116 -- | URI pointing to manifest, e.g. a list of further items.
1117 , manifest :: Maybe Text
1118
1119 -- | Search string.
1120 , keywordTopic :: Maybe Text
1121
1122 -- | A source to be queried after not being able to find and
1123 -- download the file in the bittorrent network in a defined
1124 -- amount of time.
1125 , acceptableSource :: Maybe URI
1126
1127 -- | Direct link to the resource.
1128 , exactSource :: Maybe URI
1129
1130 -- | URI to the tracker.
1131 , tracker :: Maybe URI
1132
1133 -- | Additional or experimental parameters.
1134 , supplement :: Map Text Text
1135 } deriving (Eq, Ord, Typeable)
1136
1137instance QueryValueLike Integer where
1138 toQueryValue = toQueryValue . show
1139
1140instance QueryValueLike URI where
1141 toQueryValue = toQueryValue . show
1142
1143instance QueryLike Magnet where
1144 toQuery Magnet {..} =
1145 [ ("xt", toQueryValue $ infohashURN exactTopic)
1146 , ("dn", toQueryValue displayName)
1147 , ("xl", toQueryValue exactLength)
1148 , ("mt", toQueryValue manifest)
1149 , ("kt", toQueryValue keywordTopic)
1150 , ("as", toQueryValue acceptableSource)
1151 , ("xs", toQueryValue exactSource)
1152 , ("tr", toQueryValue tracker)
1153 ]
1154
1155instance QueryValueLike Magnet where
1156 toQueryValue = toQueryValue . renderMagnet
1157
1158instance Convertible QueryText Magnet where
1159 safeConvert xs = do
1160 urnStr <- getTextMsg "xt" "exact topic not defined" xs
1161 infoHash <- convertVia (error "safeConvert" :: URN) urnStr
1162 return Magnet
1163 { exactTopic = infoHash
1164 , displayName = getText "dn" xs
1165 , exactLength = getText "xl" xs >>= getInt
1166 , manifest = getText "mt" xs
1167 , keywordTopic = getText "kt" xs
1168 , acceptableSource = getText "as" xs >>= getURI
1169 , exactSource = getText "xs" xs >>= getURI
1170 , tracker = getText "tr" xs >>= getURI
1171 , supplement = M.empty
1172 }
1173 where
1174 getInt = either (const Nothing) (Just . fst) . signed decimal
1175 getURI = parseURI . T.unpack
1176 getText p = join . L.lookup p
1177 getTextMsg p msg ps = maybe (convError msg xs) pure $ getText p ps
1178
1179magnetScheme :: URI
1180magnetScheme = URI
1181 { uriScheme = "magnet:"
1182 , uriAuthority = Nothing
1183 , uriPath = ""
1184 , uriQuery = ""
1185 , uriFragment = ""
1186 }
1187
1188isMagnetURI :: URI -> Bool
1189isMagnetURI u = u { uriQuery = "" } == magnetScheme
1190
1191-- | Can be used instead of 'parseMagnet'.
1192instance Convertible URI Magnet where
1193 safeConvert u @ URI {..}
1194 | not (isMagnetURI u) = convError "this is not a magnet link" u
1195 | otherwise = safeConvert $ parseQueryText $ BC.pack uriQuery
1196
1197-- | Can be used instead of 'renderMagnet'.
1198instance Convertible Magnet URI where
1199 safeConvert m = pure $ magnetScheme
1200 { uriQuery = BC.unpack $ renderQuery True $ toQuery m }
1201
1202instance Convertible String Magnet where
1203 safeConvert str
1204 | Just uri <- parseURI str = safeConvert uri
1205 | otherwise = convError "unable to parse uri" str
1206
1207------------------------------------------------------------------------
1208
1209-- | Meaningless placeholder value.
1210instance Default Magnet where
1211 def = Magnet
1212 { exactTopic = def
1213 , displayName = Nothing
1214 , exactLength = Nothing
1215 , manifest = Nothing
1216 , keywordTopic = Nothing
1217 , acceptableSource = Nothing
1218 , exactSource = Nothing
1219 , tracker = Nothing
1220 , supplement = M.empty
1221 }
1222
1223-- | Set 'exactTopic' ('xt' param) only, other params are empty.
1224nullMagnet :: InfoHash -> Magnet
1225nullMagnet u = Magnet
1226 { exactTopic = u
1227 , displayName = Nothing
1228 , exactLength = Nothing
1229 , manifest = Nothing
1230 , keywordTopic = Nothing
1231 , acceptableSource = Nothing
1232 , exactSource = Nothing
1233 , tracker = Nothing
1234 , supplement = M.empty
1235 }
1236
1237-- | Like 'nullMagnet' but also include 'displayName' ('dn' param).
1238simpleMagnet :: Torrent -> Magnet
1239simpleMagnet Torrent {tInfoDict = InfoDict {..}}
1240 = (nullMagnet idInfoHash)
1241 { displayName = Just $ T.decodeUtf8 $ suggestedName idLayoutInfo
1242 }
1243
1244-- | Like 'simpleMagnet' but also include 'exactLength' ('xl' param) and
1245-- 'tracker' ('tr' param).
1246--
1247detailedMagnet :: Torrent -> Magnet
1248detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce}
1249 = (simpleMagnet t)
1250 { exactLength = Just $ fromIntegral $ contentLength idLayoutInfo
1251 , tracker = tAnnounce
1252 }
1253
1254-----------------------------------------------------------------------
1255
1256parseMagnetStr :: String -> Maybe Magnet
1257parseMagnetStr = either (const Nothing) Just . safeConvert
1258
1259renderMagnetStr :: Magnet -> String
1260renderMagnetStr = show . (convert :: Magnet -> URI)
1261
1262instance Pretty Magnet where
1263 pretty = PP.text . renderMagnetStr
1264
1265instance Show Magnet where
1266 show = renderMagnetStr
1267 {-# INLINE show #-}
1268
1269instance Read Magnet where
1270 readsPrec _ xs
1271 | Just m <- parseMagnetStr mstr = [(m, rest)]
1272 | otherwise = []
1273 where
1274 (mstr, rest) = L.break (== ' ') xs
1275
1276instance IsString Magnet where
1277 fromString str = fromMaybe (error msg) $ parseMagnetStr str
1278 where
1279 msg = "unable to parse magnet: " ++ str
1280
1281-- | Try to parse magnet link from urlencoded string. Use
1282-- 'safeConvert' to find out error location.
1283--
1284parseMagnet :: Text -> Maybe Magnet
1285parseMagnet = parseMagnetStr . T.unpack
1286{-# INLINE parseMagnet #-}
1287
1288-- | Render magnet link to urlencoded string
1289renderMagnet :: Magnet -> Text
1290renderMagnet = T.pack . renderMagnetStr
1291{-# INLINE renderMagnet #-}