diff options
Diffstat (limited to 'src/Data/Torrent.hs')
-rw-r--r-- | src/Data/Torrent.hs | 989 |
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 #-} |
27 | module Data.Torrent | 33 | module 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 | ||
68 | import Prelude hiding (sum) | 147 | import Prelude |
69 | import Control.Applicative | 148 | import Control.Applicative |
70 | import qualified Crypto.Hash.SHA1 as C | ||
71 | import Control.DeepSeq | 149 | import Control.DeepSeq |
72 | import Control.Exception | 150 | import Control.Exception |
73 | import Control.Lens | 151 | import Control.Lens |
152 | import Control.Monad | ||
153 | import Crypto.Hash.SHA1 as SHA1 | ||
74 | import Data.BEncode as BE | 154 | import Data.BEncode as BE |
75 | import Data.BEncode.Types as BE | 155 | import Data.BEncode.Types as BE |
76 | import Data.ByteString as BS | 156 | import Data.Bits |
77 | import qualified Data.ByteString.Char8 as BC (pack, unpack) | 157 | import Data.Bits.Extras |
78 | import qualified Data.ByteString.Lazy as BL | 158 | import Data.ByteString as BS |
79 | import Data.Convertible | 159 | import Data.ByteString.Base16 as Base16 |
80 | import Data.Default | 160 | import Data.ByteString.Base32 as Base32 |
81 | import Data.Hashable as Hashable | 161 | import Data.ByteString.Base64 as Base64 |
82 | import qualified Data.List as L | 162 | import Data.ByteString.Char8 as BC (pack, unpack) |
83 | import Data.Text as T | 163 | import Data.ByteString.Lazy as BL |
84 | import Data.Time | 164 | import Data.Char |
165 | import Data.Convertible | ||
166 | import Data.Default | ||
167 | import Data.Foldable as F | ||
168 | import Data.Hashable as Hashable | ||
169 | import Data.Int | ||
170 | import Data.List as L | ||
171 | import Data.Map as M | ||
172 | import Data.Maybe | ||
173 | import Data.Serialize as S | ||
174 | import Data.String | ||
175 | import Data.Text as T | ||
176 | import Data.Text.Encoding as T | ||
177 | import Data.Text.Read | ||
85 | import Data.Time.Clock.POSIX | 178 | import Data.Time.Clock.POSIX |
86 | import Data.Typeable | 179 | import Data.Typeable |
87 | import Network (HostName) | 180 | import Network (HostName) |
181 | import Network.HTTP.Types.QueryLike | ||
182 | import Network.HTTP.Types.URI | ||
88 | import Network.URI | 183 | import Network.URI |
184 | import Text.ParserCombinators.ReadP as P | ||
89 | import Text.PrettyPrint as PP | 185 | import Text.PrettyPrint as PP |
90 | import Text.PrettyPrint.Class | 186 | import Text.PrettyPrint.Class |
91 | import System.FilePath | 187 | import System.FilePath |
188 | import System.Posix.Types | ||
189 | |||
190 | import 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. | ||
211 | newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString } | ||
212 | deriving (Eq, Ord, Typeable) | ||
213 | |||
214 | infoHashLen :: Int | ||
215 | infoHashLen = 20 | ||
216 | |||
217 | -- | Meaningless placeholder value. | ||
218 | instance Default InfoHash where | ||
219 | def = "0123456789012345678901234567890123456789" | ||
220 | |||
221 | -- | Hash raw bytes. (no encoding) | ||
222 | instance Hashable InfoHash where | ||
223 | hashWithSalt s (InfoHash ih) = hashWithSalt s ih | ||
224 | {-# INLINE hashWithSalt #-} | ||
225 | |||
226 | -- | Convert to\/from raw bencoded string. (no encoding) | ||
227 | instance BEncode InfoHash where | ||
228 | toBEncode = toBEncode . getInfoHash | ||
229 | fromBEncode be = InfoHash <$> fromBEncode be | ||
230 | |||
231 | -- | Convert to\/from raw bytestring. (no encoding) | ||
232 | instance 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) | ||
240 | instance QueryValueLike InfoHash where | ||
241 | toQueryValue (InfoHash ih) = Just ih | ||
242 | {-# INLINE toQueryValue #-} | ||
243 | |||
244 | -- | Convert to base16 encoded string. | ||
245 | instance Show InfoHash where | ||
246 | show (InfoHash ih) = BC.unpack (Base16.encode ih) | ||
247 | |||
248 | -- | Convert to base16 encoded Doc string. | ||
249 | instance Pretty InfoHash where | ||
250 | pretty = text . show | ||
251 | |||
252 | -- | Read base16 encoded string. | ||
253 | instance 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. | ||
265 | instance 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. | ||
271 | instance 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. | ||
296 | instance IsString InfoHash where | ||
297 | fromString = either (error . prettyConvertError) id . safeConvert . T.pack | ||
298 | |||
299 | ignoreErrorMsg :: Either a b -> Maybe b | ||
300 | ignoreErrorMsg = either (const Nothing) Just | ||
301 | |||
302 | -- | Tries both base16 and base32 while decoding info hash. | ||
303 | -- | ||
304 | -- Use 'safeConvert' for detailed error messages. | ||
305 | -- | ||
306 | textToInfoHash :: Text -> Maybe InfoHash | ||
307 | textToInfoHash = ignoreErrorMsg . safeConvert | ||
92 | 308 | ||
93 | import Data.Torrent.InfoHash as IH | 309 | -- | Hex encode infohash to text, full length. |
94 | import Data.Torrent.Layout | 310 | longHex :: InfoHash -> Text |
95 | import Data.Torrent.Piece | 311 | longHex = T.decodeUtf8 . Base16.encode . getInfoHash |
96 | import Network.BitTorrent.Core.NodeInfo | 312 | |
313 | -- | The same as 'longHex', but only first 7 characters. | ||
314 | shortHex :: InfoHash -> Text | ||
315 | shortHex = T.take 7 . longHex | ||
316 | |||
317 | {----------------------------------------------------------------------- | ||
318 | -- File info | ||
319 | -----------------------------------------------------------------------} | ||
320 | |||
321 | -- | Size of a file in bytes. | ||
322 | type FileSize = FileOffset | ||
323 | |||
324 | deriving instance BEncode FileOffset | ||
325 | |||
326 | -- | Contain metainfo about one single file. | ||
327 | data 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 | |||
352 | makeLensesFor | ||
353 | [ ("fiLength", "fileLength") | ||
354 | , ("fiMD5Sum", "fileMD5Sum") | ||
355 | , ("fiName" , "filePath" ) | ||
356 | ] | ||
357 | ''FileInfo | ||
358 | |||
359 | instance NFData a => NFData (FileInfo a) where | ||
360 | rnf FileInfo {..} = rnf fiName | ||
361 | {-# INLINE rnf #-} | ||
362 | |||
363 | instance 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 | |||
377 | type Put a = a -> BDict -> BDict | ||
378 | |||
379 | putFileInfoSingle :: Data.Torrent.Put (FileInfo BS.ByteString) | ||
380 | putFileInfoSingle FileInfo {..} cont = | ||
381 | "length" .=! fiLength | ||
382 | .: "md5sum" .=? fiMD5Sum | ||
383 | .: "name" .=! fiName | ||
384 | .: cont | ||
385 | |||
386 | getFileInfoSingle :: BE.Get (FileInfo BS.ByteString) | ||
387 | getFileInfoSingle = do | ||
388 | FileInfo <$>! "length" | ||
389 | <*>? "md5sum" | ||
390 | <*>! "name" | ||
391 | |||
392 | instance BEncode (FileInfo BS.ByteString) where | ||
393 | toBEncode = toDict . (`putFileInfoSingle` endDict) | ||
394 | {-# INLINE toBEncode #-} | ||
395 | |||
396 | fromBEncode = fromDict getFileInfoSingle | ||
397 | {-# INLINE fromBEncode #-} | ||
398 | |||
399 | instance 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. | ||
408 | joinFilePath :: FileInfo [BS.ByteString] -> FileInfo BS.ByteString | ||
409 | joinFilePath = 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 | -- | ||
421 | data 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 | |||
435 | makeLensesFor | ||
436 | [ ("liFile" , "singleFile" ) | ||
437 | , ("liFiles" , "multiFile" ) | ||
438 | , ("liDirName", "rootDirName") | ||
439 | ] | ||
440 | ''LayoutInfo | ||
441 | |||
442 | instance NFData LayoutInfo where | ||
443 | rnf SingleFile {..} = () | ||
444 | rnf MultiFile {..} = rnf liFiles | ||
445 | |||
446 | -- | Empty multifile layout. | ||
447 | instance Default LayoutInfo where | ||
448 | def = MultiFile [] "" | ||
449 | |||
450 | getLayoutInfo :: BE.Get LayoutInfo | ||
451 | getLayoutInfo = single <|> multi | ||
452 | where | ||
453 | single = SingleFile <$> getFileInfoSingle | ||
454 | multi = MultiFile <$>! "files" <*>! "name" | ||
455 | |||
456 | putLayoutInfo :: Data.Torrent.Put LayoutInfo | ||
457 | putLayoutInfo SingleFile {..} = putFileInfoSingle liFile | ||
458 | putLayoutInfo MultiFile {..} = \ cont -> | ||
459 | "files" .=! liFiles | ||
460 | .: "name" .=! liDirName | ||
461 | .: cont | ||
462 | |||
463 | instance BEncode LayoutInfo where | ||
464 | toBEncode = toDict . (`putLayoutInfo` endDict) | ||
465 | fromBEncode = fromDict getLayoutInfo | ||
466 | |||
467 | instance 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. | ||
472 | isSingleFile :: LayoutInfo -> Bool | ||
473 | isSingleFile SingleFile {} = True | ||
474 | isSingleFile _ = False | ||
475 | {-# INLINE isSingleFile #-} | ||
476 | |||
477 | -- | Test if this is multifile torrent. | ||
478 | isMultiFile :: LayoutInfo -> Bool | ||
479 | isMultiFile MultiFile {} = True | ||
480 | isMultiFile _ = False | ||
481 | {-# INLINE isMultiFile #-} | ||
482 | |||
483 | -- | Get name of the torrent based on the root path piece. | ||
484 | suggestedName :: LayoutInfo -> BS.ByteString | ||
485 | suggestedName (SingleFile FileInfo {..}) = fiName | ||
486 | suggestedName MultiFile {..} = liDirName | ||
487 | {-# INLINE suggestedName #-} | ||
488 | |||
489 | -- | Find sum of sizes of the all torrent files. | ||
490 | contentLength :: LayoutInfo -> FileSize | ||
491 | contentLength SingleFile { liFile = FileInfo {..} } = fiLength | ||
492 | contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs) | ||
493 | |||
494 | -- | Get number of all files in torrent. | ||
495 | fileCount :: LayoutInfo -> Int | ||
496 | fileCount SingleFile {..} = 1 | ||
497 | fileCount 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. | ||
501 | blockCount :: Int -> LayoutInfo -> Int | ||
502 | blockCount 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 | -- | ||
511 | type FileLayout a = [(FilePath, a)] | ||
512 | |||
513 | -- | Extract files layout from torrent info with the given root path. | ||
514 | flatLayout | ||
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. | ||
518 | flatLayout prefixPath SingleFile { liFile = FileInfo {..} } | ||
519 | = [(prefixPath </> BC.unpack fiName, fiLength)] | ||
520 | flatLayout 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. | ||
528 | accumPositions :: FileLayout FileSize -> FileLayout (FileOffset, FileSize) | ||
529 | accumPositions = 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. | ||
535 | fileOffset :: FilePath -> FileLayout FileOffset -> Maybe FileOffset | ||
536 | fileOffset = L.lookup | ||
537 | {-# INLINE fileOffset #-} | ||
538 | |||
539 | ------------------------------------------------------------------------ | ||
540 | |||
541 | -- | Divide and round up. | ||
542 | sizeInBase :: Integral a => a -> Int -> Int | ||
543 | sizeInBase 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. | ||
554 | type 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 | -- | ||
562 | type PieceSize = Int | ||
563 | |||
564 | -- | Number of pieces in torrent or a part of torrent. | ||
565 | type PieceCount = Int | ||
566 | |||
567 | defaultBlockSize :: Int | ||
568 | defaultBlockSize = 16 * 1024 | ||
569 | |||
570 | -- | Optimal number of pieces in torrent. | ||
571 | optimalPieceCount :: PieceCount | ||
572 | optimalPieceCount = 1000 | ||
573 | {-# INLINE optimalPieceCount #-} | ||
574 | |||
575 | -- | Piece size should not be less than this value. | ||
576 | minPieceSize :: Int | ||
577 | minPieceSize = defaultBlockSize * 4 | ||
578 | {-# INLINE minPieceSize #-} | ||
579 | |||
580 | -- | To prevent transfer degradation piece size should not exceed this | ||
581 | -- value. | ||
582 | maxPieceSize :: Int | ||
583 | maxPieceSize = 4 * 1024 * 1024 | ||
584 | {-# INLINE maxPieceSize #-} | ||
585 | |||
586 | toPow2 :: Int -> Int | ||
587 | toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x) | ||
588 | |||
589 | -- | Find the optimal piece size for a given torrent size. | ||
590 | defaultPieceSize :: Int64 -> Int | ||
591 | defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc | ||
592 | where | ||
593 | pc = fromIntegral (x `div` fromIntegral optimalPieceCount) | ||
594 | |||
595 | {----------------------------------------------------------------------- | ||
596 | -- Piece data | ||
597 | -----------------------------------------------------------------------} | ||
598 | |||
599 | type PieceHash = BS.ByteString | ||
600 | |||
601 | hashsize :: Int | ||
602 | hashsize = 20 | ||
603 | {-# INLINE hashsize #-} | ||
604 | |||
605 | -- TODO check if pieceLength is power of 2 | ||
606 | -- | Piece payload should be strict or lazy bytestring. | ||
607 | data 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 | |||
615 | instance NFData (Piece a) | ||
616 | |||
617 | -- | Payload bytes are omitted. | ||
618 | instance Pretty (Piece a) where | ||
619 | pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) | ||
620 | |||
621 | -- | Get size of piece in bytes. | ||
622 | pieceSize :: Piece BL.ByteString -> PieceSize | ||
623 | pieceSize Piece {..} = fromIntegral (BL.length pieceData) | ||
624 | |||
625 | -- | Get piece hash. | ||
626 | hashPiece :: Piece BL.ByteString -> PieceHash | ||
627 | hashPiece Piece {..} = SHA1.hashlazy pieceData | ||
628 | |||
629 | {----------------------------------------------------------------------- | ||
630 | -- Piece control | ||
631 | -----------------------------------------------------------------------} | ||
632 | |||
633 | -- | A flat array of SHA1 hash for each piece. | ||
634 | newtype HashList = HashList { unHashList :: BS.ByteString } | ||
635 | deriving (Show, Read, Eq, BEncode, Typeable) | ||
636 | |||
637 | -- | Empty hash list. | ||
638 | instance Default HashList where | ||
639 | def = HashList "" | ||
640 | |||
641 | -- | Part of torrent file used for torrent content validation. | ||
642 | data 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. | ||
651 | makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo | ||
652 | |||
653 | -- | Concatenation of all 20-byte SHA1 hash values. | ||
654 | makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo | ||
655 | |||
656 | instance NFData PieceInfo | ||
657 | |||
658 | instance Default PieceInfo where | ||
659 | def = PieceInfo 1 def | ||
660 | |||
661 | class Lint a where | ||
662 | lint :: a -> Either String a | ||
663 | |||
664 | instance 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 | |||
671 | putPieceInfo :: Data.Torrent.Put PieceInfo | ||
672 | putPieceInfo PieceInfo {..} cont = | ||
673 | "piece length" .=! piPieceLength | ||
674 | .: "pieces" .=! piPieceHashes | ||
675 | .: cont | ||
676 | |||
677 | getPieceInfo :: BE.Get PieceInfo | ||
678 | getPieceInfo = do | ||
679 | PieceInfo <$>! "piece length" | ||
680 | <*>! "pieces" | ||
681 | |||
682 | instance BEncode PieceInfo where | ||
683 | toBEncode = toDict . (`putPieceInfo` endDict) | ||
684 | fromBEncode = fromDict getPieceInfo | ||
685 | |||
686 | -- | Hashes are omitted. | ||
687 | instance Pretty PieceInfo where | ||
688 | pretty PieceInfo {..} = "Piece size: " <> int piPieceLength | ||
689 | |||
690 | slice :: Int -> Int -> BS.ByteString -> BS.ByteString | ||
691 | slice start len = BS.take len . BS.drop start | ||
692 | {-# INLINE slice #-} | ||
693 | |||
694 | -- | Extract validation hash by specified piece index. | ||
695 | pieceHash :: PieceInfo -> PieceIx -> PieceHash | ||
696 | pieceHash 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. | ||
700 | pieceCount :: PieceInfo -> PieceCount | ||
701 | pieceCount PieceInfo {..} = BS.length (unHashList piPieceHashes) `quot` hashsize | ||
702 | |||
703 | -- | Test if this is last piece in torrent content. | ||
704 | isLastPiece :: PieceInfo -> PieceIx -> Bool | ||
705 | isLastPiece ci i = pieceCount ci == succ i | ||
706 | |||
707 | -- | Validate piece with metainfo hash. | ||
708 | checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool | ||
709 | checkPieceLazy 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 | |||
145 | infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict | 761 | infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict |
146 | infoDictionary li pinfo private = InfoDict ih li pinfo private | 762 | infoDictionary 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 | ||
150 | getPrivate :: Get Bool | 766 | getPrivate :: BE.Get Bool |
151 | getPrivate = (Just True ==) <$>? "private" | 767 | getPrivate = (Just True ==) <$>? "private" |
152 | 768 | ||
153 | putPrivate :: Bool -> BDict -> BDict | 769 | putPrivate :: 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. |
158 | hashLazyIH :: BL.ByteString -> InfoHash | 774 | hashLazyIH :: BL.ByteString -> InfoHash |
159 | hashLazyIH = either (const (error msg)) id . safeConvert . C.hashlazy | 775 | hashLazyIH = 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 | ||
177 | ppPrivacy :: Bool -> Doc | 793 | ppPrivacy :: Bool -> Doc |
178 | ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public" | 794 | ppPrivacy 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. |
194 | data Torrent = Torrent | 811 | data 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 | |||
361 | fromFile :: FilePath -> IO Torrent | 978 | fromFile :: FilePath -> IO Torrent |
362 | fromFile filepath = do | 979 | fromFile 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. |
369 | toFile :: FilePath -> Torrent -> IO () | 986 | toFile :: FilePath -> Torrent -> IO () |
370 | toFile filepath = BL.writeFile filepath . encode | 987 | toFile filepath = BL.writeFile filepath . BE.encode |
988 | |||
989 | {----------------------------------------------------------------------- | ||
990 | -- URN | ||
991 | -----------------------------------------------------------------------} | ||
992 | |||
993 | -- | Namespace identifier determines the syntactic interpretation of | ||
994 | -- namespace-specific string. | ||
995 | type 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 | -- | ||
1001 | btih :: NamespaceId | ||
1002 | btih = ["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 | -- | ||
1009 | data 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 | |||
1017 | instance 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 | -- | ||
1025 | infohashURN :: InfoHash -> URN | ||
1026 | infohashURN = URN btih . longHex | ||
1027 | |||
1028 | -- | Meaningless placeholder value. | ||
1029 | instance Default URN where | ||
1030 | def = infohashURN def | ||
1031 | |||
1032 | ------------------------------------------------------------------------ | ||
1033 | |||
1034 | -- | Render URN to its text representation. | ||
1035 | renderURN :: URN -> Text | ||
1036 | renderURN URN {..} | ||
1037 | = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString] | ||
1038 | |||
1039 | instance Pretty URN where | ||
1040 | pretty = text . T.unpack . renderURN | ||
1041 | |||
1042 | instance Show URN where | ||
1043 | showsPrec n = showsPrec n . T.unpack . renderURN | ||
1044 | |||
1045 | instance 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 | |||
1055 | instance 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 | |||
1068 | instance 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 | -- | ||
1076 | parseURN :: Text -> Maybe URN | ||
1077 | parseURN = 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. | ||
1104 | data 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 | |||
1137 | instance QueryValueLike Integer where | ||
1138 | toQueryValue = toQueryValue . show | ||
1139 | |||
1140 | instance QueryValueLike URI where | ||
1141 | toQueryValue = toQueryValue . show | ||
1142 | |||
1143 | instance 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 | |||
1155 | instance QueryValueLike Magnet where | ||
1156 | toQueryValue = toQueryValue . renderMagnet | ||
1157 | |||
1158 | instance 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 | |||
1179 | magnetScheme :: URI | ||
1180 | magnetScheme = URI | ||
1181 | { uriScheme = "magnet:" | ||
1182 | , uriAuthority = Nothing | ||
1183 | , uriPath = "" | ||
1184 | , uriQuery = "" | ||
1185 | , uriFragment = "" | ||
1186 | } | ||
1187 | |||
1188 | isMagnetURI :: URI -> Bool | ||
1189 | isMagnetURI u = u { uriQuery = "" } == magnetScheme | ||
1190 | |||
1191 | -- | Can be used instead of 'parseMagnet'. | ||
1192 | instance 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'. | ||
1198 | instance Convertible Magnet URI where | ||
1199 | safeConvert m = pure $ magnetScheme | ||
1200 | { uriQuery = BC.unpack $ renderQuery True $ toQuery m } | ||
1201 | |||
1202 | instance 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. | ||
1210 | instance 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. | ||
1224 | nullMagnet :: InfoHash -> Magnet | ||
1225 | nullMagnet 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). | ||
1238 | simpleMagnet :: Torrent -> Magnet | ||
1239 | simpleMagnet 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 | -- | ||
1247 | detailedMagnet :: Torrent -> Magnet | ||
1248 | detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce} | ||
1249 | = (simpleMagnet t) | ||
1250 | { exactLength = Just $ fromIntegral $ contentLength idLayoutInfo | ||
1251 | , tracker = tAnnounce | ||
1252 | } | ||
1253 | |||
1254 | ----------------------------------------------------------------------- | ||
1255 | |||
1256 | parseMagnetStr :: String -> Maybe Magnet | ||
1257 | parseMagnetStr = either (const Nothing) Just . safeConvert | ||
1258 | |||
1259 | renderMagnetStr :: Magnet -> String | ||
1260 | renderMagnetStr = show . (convert :: Magnet -> URI) | ||
1261 | |||
1262 | instance Pretty Magnet where | ||
1263 | pretty = PP.text . renderMagnetStr | ||
1264 | |||
1265 | instance Show Magnet where | ||
1266 | show = renderMagnetStr | ||
1267 | {-# INLINE show #-} | ||
1268 | |||
1269 | instance Read Magnet where | ||
1270 | readsPrec _ xs | ||
1271 | | Just m <- parseMagnetStr mstr = [(m, rest)] | ||
1272 | | otherwise = [] | ||
1273 | where | ||
1274 | (mstr, rest) = L.break (== ' ') xs | ||
1275 | |||
1276 | instance 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 | -- | ||
1284 | parseMagnet :: Text -> Maybe Magnet | ||
1285 | parseMagnet = parseMagnetStr . T.unpack | ||
1286 | {-# INLINE parseMagnet #-} | ||
1287 | |||
1288 | -- | Render magnet link to urlencoded string | ||
1289 | renderMagnet :: Magnet -> Text | ||
1290 | renderMagnet = T.pack . renderMagnetStr | ||
1291 | {-# INLINE renderMagnet #-} | ||