diff options
author | James Crayne <jim.crayne@gmail.com> | 2019-09-28 15:33:33 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 19:33:39 -0500 |
commit | 51d24d17974235a4c2a0d8a913bbbdc7f4d2c001 (patch) | |
tree | 7fdb092ddcc7d857988feb93ee3ec0d7a27acb25 /torrent-types/src/Data | |
parent | 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (diff) |
Move Data.Torrent to torrent-types library
Diffstat (limited to 'torrent-types/src/Data')
-rw-r--r-- | torrent-types/src/Data/.Torrent.hs.swo | bin | 0 -> 16384 bytes | |||
-rw-r--r-- | torrent-types/src/Data/.Torrent.hs.swp | bin | 0 -> 57344 bytes | |||
-rw-r--r-- | torrent-types/src/Data/Torrent.hs | 1364 |
3 files changed, 1364 insertions, 0 deletions
diff --git a/torrent-types/src/Data/.Torrent.hs.swo b/torrent-types/src/Data/.Torrent.hs.swo new file mode 100644 index 00000000..9f06d911 --- /dev/null +++ b/torrent-types/src/Data/.Torrent.hs.swo | |||
Binary files differ | |||
diff --git a/torrent-types/src/Data/.Torrent.hs.swp b/torrent-types/src/Data/.Torrent.hs.swp new file mode 100644 index 00000000..0aecaad6 --- /dev/null +++ b/torrent-types/src/Data/.Torrent.hs.swp | |||
Binary files differ | |||
diff --git a/torrent-types/src/Data/Torrent.hs b/torrent-types/src/Data/Torrent.hs new file mode 100644 index 00000000..a1eb286c --- /dev/null +++ b/torrent-types/src/Data/Torrent.hs | |||
@@ -0,0 +1,1364 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Torrent file contains metadata about files and folders but not | ||
9 | -- content itself. The files are bencoded dictionaries. There is | ||
10 | -- also other info which is used to help join the swarm. | ||
11 | -- | ||
12 | -- This module provides torrent metainfo serialization and info hash | ||
13 | -- extraction. | ||
14 | -- | ||
15 | -- For more info see: | ||
16 | -- <http://www.bittorrent.org/beps/bep_0003.html#metainfo-files>, | ||
17 | -- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure> | ||
18 | -- | ||
19 | {-# LANGUAGE CPP #-} | ||
20 | {-# LANGUAGE NamedFieldPuns #-} | ||
21 | {-# LANGUAGE FlexibleInstances #-} | ||
22 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
23 | {-# LANGUAGE BangPatterns #-} | ||
24 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
25 | {-# LANGUAGE StandaloneDeriving #-} | ||
26 | {-# LANGUAGE DeriveDataTypeable #-} | ||
27 | {-# LANGUAGE DeriveFunctor #-} | ||
28 | {-# LANGUAGE DeriveFoldable #-} | ||
29 | {-# LANGUAGE DeriveTraversable #-} | ||
30 | {-# LANGUAGE TemplateHaskell #-} | ||
31 | {-# LANGUAGE RecordWildCards #-} | ||
32 | {-# LANGUAGE OverloadedStrings #-} | ||
33 | {-# OPTIONS -fno-warn-orphans #-} | ||
34 | module Data.Torrent | ||
35 | ( -- * InfoHash | ||
36 | -- $infohash | ||
37 | InfoHash(..) | ||
38 | , textToInfoHash | ||
39 | , longHex | ||
40 | , shortHex | ||
41 | |||
42 | -- * File layout | ||
43 | -- ** FileInfo | ||
44 | , FileOffset | ||
45 | , FileSize | ||
46 | , FileInfo (..) | ||
47 | #ifdef USE_lens | ||
48 | , fileLength | ||
49 | , filePath | ||
50 | , fileMD5Sum | ||
51 | #endif | ||
52 | |||
53 | -- ** Layout info | ||
54 | , LayoutInfo (..) | ||
55 | #ifdef USE_lens | ||
56 | , singleFile | ||
57 | , multiFile | ||
58 | , rootDirName | ||
59 | #endif | ||
60 | , joinFilePath | ||
61 | , isSingleFile | ||
62 | , isMultiFile | ||
63 | , suggestedName | ||
64 | , contentLength | ||
65 | , fileCount | ||
66 | , blockCount | ||
67 | |||
68 | -- ** Flat layout info | ||
69 | , FileLayout | ||
70 | , flatLayout | ||
71 | , accumPositions | ||
72 | , fileOffset | ||
73 | |||
74 | -- ** Internal | ||
75 | , sizeInBase | ||
76 | |||
77 | -- * Pieces | ||
78 | -- ** Attributes | ||
79 | , PieceIx | ||
80 | , PieceCount | ||
81 | , PieceSize | ||
82 | , minPieceSize | ||
83 | , maxPieceSize | ||
84 | , defaultPieceSize | ||
85 | , PieceHash | ||
86 | |||
87 | -- ** Piece data | ||
88 | , Piece (..) | ||
89 | , pieceSize | ||
90 | , hashPiece | ||
91 | |||
92 | -- ** Piece control | ||
93 | , HashList (..) | ||
94 | , PieceInfo (..) | ||
95 | #ifdef USE_lens | ||
96 | , pieceLength | ||
97 | , pieceHashes | ||
98 | #endif | ||
99 | , pieceCount | ||
100 | |||
101 | -- ** Validation | ||
102 | , pieceHash | ||
103 | , checkPieceLazy | ||
104 | |||
105 | -- * Info dictionary | ||
106 | , InfoDict (..) | ||
107 | #ifdef USE_lens | ||
108 | , infohash | ||
109 | , layoutInfo | ||
110 | , pieceInfo | ||
111 | , isPrivate | ||
112 | #endif | ||
113 | #ifdef VERSION_bencoding | ||
114 | , infoDictionary | ||
115 | #endif | ||
116 | |||
117 | -- * Torrent file | ||
118 | , Torrent(..) | ||
119 | |||
120 | #ifdef USE_lens | ||
121 | -- ** Lenses | ||
122 | , announce | ||
123 | , announceList | ||
124 | , comment | ||
125 | , createdBy | ||
126 | , creationDate | ||
127 | , encoding | ||
128 | , infoDict | ||
129 | , publisher | ||
130 | , publisherURL | ||
131 | , signature | ||
132 | #endif | ||
133 | |||
134 | -- ** Utils | ||
135 | , nullTorrent | ||
136 | , typeTorrent | ||
137 | , torrentExt | ||
138 | , isTorrentPath | ||
139 | #ifdef VERSION_bencoding | ||
140 | , fromFile | ||
141 | , toFile | ||
142 | #endif | ||
143 | |||
144 | -- * Magnet | ||
145 | -- $magnet-link | ||
146 | , Magnet(..) | ||
147 | , nullMagnet | ||
148 | , simpleMagnet | ||
149 | , detailedMagnet | ||
150 | , parseMagnet | ||
151 | , renderMagnet | ||
152 | |||
153 | -- ** URN | ||
154 | , URN (..) | ||
155 | , NamespaceId | ||
156 | , btih | ||
157 | , infohashURN | ||
158 | , parseURN | ||
159 | , renderURN | ||
160 | ) where | ||
161 | |||
162 | import Prelude hiding ((<>)) | ||
163 | import Control.Applicative | ||
164 | import Control.DeepSeq | ||
165 | import Control.Exception | ||
166 | -- import Control.Lens | ||
167 | import Control.Monad | ||
168 | import Crypto.Hash | ||
169 | #ifdef VERSION_bencoding | ||
170 | import Data.BEncode as BE | ||
171 | import Data.BEncode.Types as BE | ||
172 | #endif | ||
173 | import Data.Bits | ||
174 | #ifdef VERSION_bits_extras | ||
175 | import Data.Bits.Extras | ||
176 | #endif | ||
177 | import qualified Data.ByteArray as Bytes | ||
178 | import Data.ByteString as BS | ||
179 | import Data.ByteString.Base16 as Base16 | ||
180 | import Data.ByteString.Base32 as Base32 | ||
181 | import Data.ByteString.Base64 as Base64 | ||
182 | import Data.ByteString.Char8 as BC (pack, unpack) | ||
183 | import Data.ByteString.Lazy as BL | ||
184 | import Data.Char | ||
185 | import Data.Convertible | ||
186 | import Data.Default | ||
187 | import Data.Hashable as Hashable | ||
188 | import Data.Int | ||
189 | import Data.List as L | ||
190 | import Data.Map as M | ||
191 | import Data.Maybe | ||
192 | import Data.Serialize as S | ||
193 | import Data.String | ||
194 | import Data.Text as T | ||
195 | import Data.Text.Encoding as T | ||
196 | import Data.Text.Read | ||
197 | import Data.Time.Clock.POSIX | ||
198 | import Data.Typeable | ||
199 | import Network (HostName) | ||
200 | import Network.HTTP.Types.QueryLike | ||
201 | import Network.HTTP.Types.URI | ||
202 | import Network.URI | ||
203 | import Text.ParserCombinators.ReadP as P | ||
204 | import Text.PrettyPrint as PP | ||
205 | import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) | ||
206 | import System.FilePath | ||
207 | import System.Posix.Types | ||
208 | #ifdef USE_lens | ||
209 | #ifdef VERSION_lens | ||
210 | import Control.Lens.TH | ||
211 | #elif defined(VERSION_microlens_th) | ||
212 | import Lens.Micro.TH | ||
213 | #elif defined(VERSION_lens_family_th) | ||
214 | import Lens.Family.TH | ||
215 | #endif | ||
216 | #endif | ||
217 | |||
218 | import Network.Address | ||
219 | |||
220 | |||
221 | {----------------------------------------------------------------------- | ||
222 | -- Info hash | ||
223 | -----------------------------------------------------------------------} | ||
224 | -- TODO | ||
225 | -- | ||
226 | -- data Word160 = Word160 {-# UNPACK #-} !Word64 | ||
227 | -- {-# UNPACK #-} !Word64 | ||
228 | -- {-# UNPACK #-} !Word32 | ||
229 | -- | ||
230 | -- newtype InfoHash = InfoHash Word160 | ||
231 | -- | ||
232 | -- reason: bytestring have overhead = 8 words, while infohash have length 20 bytes | ||
233 | |||
234 | -- $infohash | ||
235 | -- | ||
236 | -- Infohash is a unique identifier of torrent. | ||
237 | |||
238 | -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. | ||
239 | newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString } | ||
240 | deriving (Eq, Ord, Typeable) | ||
241 | |||
242 | infoHashLen :: Int | ||
243 | infoHashLen = 20 | ||
244 | |||
245 | -- | Meaningless placeholder value. | ||
246 | instance Default InfoHash where | ||
247 | def = "0123456789012345678901234567890123456789" | ||
248 | |||
249 | -- | Hash raw bytes. (no encoding) | ||
250 | instance Hashable InfoHash where | ||
251 | hashWithSalt s (InfoHash ih) = hashWithSalt s ih | ||
252 | {-# INLINE hashWithSalt #-} | ||
253 | |||
254 | #ifdef VERSION_bencoding | ||
255 | -- | Convert to\/from raw bencoded string. (no encoding) | ||
256 | instance BEncode InfoHash where | ||
257 | toBEncode = toBEncode . getInfoHash | ||
258 | fromBEncode be = InfoHash <$> fromBEncode be | ||
259 | #endif | ||
260 | |||
261 | #if 0 | ||
262 | instance TableKey KMessageOf InfoHash where | ||
263 | toNodeId = either (error msg) id . S.decode . S.encode | ||
264 | where -- TODO unsafe coerse? | ||
265 | msg = "tableKey: impossible" | ||
266 | #endif | ||
267 | |||
268 | |||
269 | -- | Convert to\/from raw bytestring. (no encoding) | ||
270 | instance Serialize InfoHash where | ||
271 | put (InfoHash ih) = putByteString ih | ||
272 | {-# INLINE put #-} | ||
273 | |||
274 | get = InfoHash <$> getBytes infoHashLen | ||
275 | {-# INLINE get #-} | ||
276 | |||
277 | -- | Convert to raw query value. (no encoding) | ||
278 | instance QueryValueLike InfoHash where | ||
279 | toQueryValue (InfoHash ih) = Just ih | ||
280 | {-# INLINE toQueryValue #-} | ||
281 | |||
282 | -- | Convert to base16 encoded string. | ||
283 | instance Show InfoHash where | ||
284 | show (InfoHash ih) = BC.unpack (Base16.encode ih) | ||
285 | |||
286 | -- | Convert to base16 encoded Doc string. | ||
287 | instance Pretty InfoHash where | ||
288 | pPrint = text . show | ||
289 | |||
290 | -- | Read base16 encoded string. | ||
291 | instance Read InfoHash where | ||
292 | readsPrec _ = readP_to_S $ do | ||
293 | str <- replicateM (infoHashLen * 2) (satisfy isHexDigit) | ||
294 | return $ InfoHash $ decodeIH str | ||
295 | where | ||
296 | decodeIH = BS.pack . L.map fromHex . pair | ||
297 | fromHex (a, b) = read $ '0' : 'x' : a : b : [] | ||
298 | |||
299 | pair (a : b : xs) = (a, b) : pair xs | ||
300 | pair _ = [] | ||
301 | |||
302 | -- | Convert raw bytes to info hash. | ||
303 | instance Convertible BS.ByteString InfoHash where | ||
304 | safeConvert bs | ||
305 | | BS.length bs == infoHashLen = pure (InfoHash bs) | ||
306 | | otherwise = convError "invalid length" bs | ||
307 | |||
308 | -- | Parse infohash from base16\/base32\/base64 encoded string. | ||
309 | instance Convertible Text InfoHash where | ||
310 | safeConvert t | ||
311 | | 20 == hashLen = pure (InfoHash hashStr) | ||
312 | | 26 <= hashLen && hashLen <= 28 = | ||
313 | case Base64.decode hashStr of | ||
314 | Left msg -> convError ("invalid base64 encoding " ++ msg) t | ||
315 | Right ihStr -> safeConvert ihStr | ||
316 | |||
317 | | hashLen == 32 = | ||
318 | case Base32.decode hashStr of | ||
319 | Left msg -> convError msg t | ||
320 | Right ihStr -> safeConvert ihStr | ||
321 | |||
322 | | hashLen == 40 = | ||
323 | let (ihStr, inv) = Base16.decode hashStr | ||
324 | in if BS.length inv /= 0 | ||
325 | then convError "invalid base16 encoding" t | ||
326 | else safeConvert ihStr | ||
327 | |||
328 | | otherwise = convError "invalid length" t | ||
329 | where | ||
330 | hashLen = BS.length hashStr | ||
331 | hashStr = T.encodeUtf8 t | ||
332 | |||
333 | -- | Decode from base16\/base32\/base64 encoded string. | ||
334 | instance IsString InfoHash where | ||
335 | fromString = either (error . prettyConvertError) id . safeConvert . T.pack | ||
336 | |||
337 | ignoreErrorMsg :: Either a b -> Maybe b | ||
338 | ignoreErrorMsg = either (const Nothing) Just | ||
339 | |||
340 | -- | Tries both base16 and base32 while decoding info hash. | ||
341 | -- | ||
342 | -- Use 'safeConvert' for detailed error messages. | ||
343 | -- | ||
344 | textToInfoHash :: Text -> Maybe InfoHash | ||
345 | textToInfoHash = ignoreErrorMsg . safeConvert | ||
346 | |||
347 | -- | Hex encode infohash to text, full length. | ||
348 | longHex :: InfoHash -> Text | ||
349 | longHex = T.decodeUtf8 . Base16.encode . getInfoHash | ||
350 | |||
351 | -- | The same as 'longHex', but only first 7 characters. | ||
352 | shortHex :: InfoHash -> Text | ||
353 | shortHex = T.take 7 . longHex | ||
354 | |||
355 | {----------------------------------------------------------------------- | ||
356 | -- File info | ||
357 | -----------------------------------------------------------------------} | ||
358 | |||
359 | -- | Size of a file in bytes. | ||
360 | type FileSize = FileOffset | ||
361 | |||
362 | #ifdef VERSION_bencoding | ||
363 | deriving instance BEncode FileOffset | ||
364 | #endif | ||
365 | |||
366 | -- | Contain metainfo about one single file. | ||
367 | data FileInfo a = FileInfo { | ||
368 | fiLength :: {-# UNPACK #-} !FileSize | ||
369 | -- ^ Length of the file in bytes. | ||
370 | |||
371 | -- TODO unpacked MD5 sum | ||
372 | , fiMD5Sum :: !(Maybe BS.ByteString) | ||
373 | -- ^ 32 character long MD5 sum of the file. Used by third-party | ||
374 | -- tools, not by bittorrent protocol itself. | ||
375 | |||
376 | , fiName :: !a | ||
377 | -- ^ One or more string elements that together represent the | ||
378 | -- path and filename. Each element in the list corresponds to | ||
379 | -- either a directory name or (in the case of the last element) | ||
380 | -- the filename. For example, the file: | ||
381 | -- | ||
382 | -- > "dir1/dir2/file.ext" | ||
383 | -- | ||
384 | -- would consist of three string elements: | ||
385 | -- | ||
386 | -- > ["dir1", "dir2", "file.ext"] | ||
387 | -- | ||
388 | } deriving (Show, Read, Eq, Typeable | ||
389 | , Functor, Foldable | ||
390 | ) | ||
391 | |||
392 | #ifdef USE_lens | ||
393 | makeLensesFor | ||
394 | [ ("fiLength", "fileLength") | ||
395 | , ("fiMD5Sum", "fileMD5Sum") | ||
396 | , ("fiName" , "filePath" ) | ||
397 | ] | ||
398 | ''FileInfo | ||
399 | #endif | ||
400 | |||
401 | instance NFData a => NFData (FileInfo a) where | ||
402 | rnf FileInfo {..} = rnf fiName | ||
403 | {-# INLINE rnf #-} | ||
404 | |||
405 | #ifdef VERSION_bencoding | ||
406 | instance BEncode (FileInfo [BS.ByteString]) where | ||
407 | toBEncode FileInfo {..} = toDict $ | ||
408 | "length" .=! fiLength | ||
409 | .: "md5sum" .=? fiMD5Sum | ||
410 | .: "path" .=! fiName | ||
411 | .: endDict | ||
412 | {-# INLINE toBEncode #-} | ||
413 | |||
414 | fromBEncode = fromDict $ do | ||
415 | FileInfo <$>! "length" | ||
416 | <*>? "md5sum" | ||
417 | <*>! "path" | ||
418 | {-# INLINE fromBEncode #-} | ||
419 | |||
420 | type Put a = a -> BDict -> BDict | ||
421 | #endif | ||
422 | |||
423 | #ifdef VERSION_bencoding | ||
424 | putFileInfoSingle :: Data.Torrent.Put (FileInfo BS.ByteString) | ||
425 | putFileInfoSingle FileInfo {..} cont = | ||
426 | "length" .=! fiLength | ||
427 | .: "md5sum" .=? fiMD5Sum | ||
428 | .: "name" .=! fiName | ||
429 | .: cont | ||
430 | |||
431 | getFileInfoSingle :: BE.Get (FileInfo BS.ByteString) | ||
432 | getFileInfoSingle = do | ||
433 | FileInfo <$>! "length" | ||
434 | <*>? "md5sum" | ||
435 | <*>! "name" | ||
436 | |||
437 | instance BEncode (FileInfo BS.ByteString) where | ||
438 | toBEncode = toDict . (`putFileInfoSingle` endDict) | ||
439 | {-# INLINE toBEncode #-} | ||
440 | |||
441 | fromBEncode = fromDict getFileInfoSingle | ||
442 | {-# INLINE fromBEncode #-} | ||
443 | #endif | ||
444 | |||
445 | instance Pretty (FileInfo BS.ByteString) where | ||
446 | pPrint FileInfo {..} = | ||
447 | "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) | ||
448 | $$ "Size: " <> text (show fiLength) | ||
449 | $$ maybe PP.empty ppMD5 fiMD5Sum | ||
450 | where | ||
451 | ppMD5 md5 = "MD5 : " <> text (show (Base16.encode md5)) | ||
452 | |||
453 | -- | Join file path. | ||
454 | joinFilePath :: FileInfo [BS.ByteString] -> FileInfo BS.ByteString | ||
455 | joinFilePath = fmap (BS.intercalate "/") | ||
456 | |||
457 | {----------------------------------------------------------------------- | ||
458 | -- Layout info | ||
459 | -----------------------------------------------------------------------} | ||
460 | |||
461 | -- | Original (found in torrent file) layout info is either: | ||
462 | -- | ||
463 | -- * Single file with its /name/. | ||
464 | -- | ||
465 | -- * Multiple files with its relative file /paths/. | ||
466 | -- | ||
467 | data LayoutInfo | ||
468 | = SingleFile | ||
469 | { -- | Single file info. | ||
470 | liFile :: !(FileInfo BS.ByteString) | ||
471 | } | ||
472 | | MultiFile | ||
473 | { -- | List of the all files that torrent contains. | ||
474 | liFiles :: ![FileInfo [BS.ByteString]] | ||
475 | |||
476 | -- | The /suggested/ name of the root directory in which to | ||
477 | -- store all the files. | ||
478 | , liDirName :: !BS.ByteString | ||
479 | } deriving (Show, Read, Eq, Typeable) | ||
480 | |||
481 | #ifdef USE_lens | ||
482 | makeLensesFor | ||
483 | [ ("liFile" , "singleFile" ) | ||
484 | , ("liFiles" , "multiFile" ) | ||
485 | , ("liDirName", "rootDirName") | ||
486 | ] | ||
487 | ''LayoutInfo | ||
488 | #endif | ||
489 | |||
490 | instance NFData LayoutInfo where | ||
491 | rnf SingleFile {..} = () | ||
492 | rnf MultiFile {..} = rnf liFiles | ||
493 | |||
494 | -- | Empty multifile layout. | ||
495 | instance Default LayoutInfo where | ||
496 | def = MultiFile [] "" | ||
497 | |||
498 | #ifdef VERSION_bencoding | ||
499 | getLayoutInfo :: BE.Get LayoutInfo | ||
500 | getLayoutInfo = single <|> multi | ||
501 | where | ||
502 | single = SingleFile <$> getFileInfoSingle | ||
503 | multi = MultiFile <$>! "files" <*>! "name" | ||
504 | |||
505 | putLayoutInfo :: Data.Torrent.Put LayoutInfo | ||
506 | putLayoutInfo SingleFile {..} = putFileInfoSingle liFile | ||
507 | putLayoutInfo MultiFile {..} = \ cont -> | ||
508 | "files" .=! liFiles | ||
509 | .: "name" .=! liDirName | ||
510 | .: cont | ||
511 | |||
512 | instance BEncode LayoutInfo where | ||
513 | toBEncode = toDict . (`putLayoutInfo` endDict) | ||
514 | fromBEncode = fromDict getLayoutInfo | ||
515 | #endif | ||
516 | |||
517 | instance Pretty LayoutInfo where | ||
518 | pPrint SingleFile {..} = pPrint liFile | ||
519 | pPrint MultiFile {..} = vcat $ L.map (pPrint . joinFilePath) liFiles | ||
520 | |||
521 | -- | Test if this is single file torrent. | ||
522 | isSingleFile :: LayoutInfo -> Bool | ||
523 | isSingleFile SingleFile {} = True | ||
524 | isSingleFile _ = False | ||
525 | {-# INLINE isSingleFile #-} | ||
526 | |||
527 | -- | Test if this is multifile torrent. | ||
528 | isMultiFile :: LayoutInfo -> Bool | ||
529 | isMultiFile MultiFile {} = True | ||
530 | isMultiFile _ = False | ||
531 | {-# INLINE isMultiFile #-} | ||
532 | |||
533 | -- | Get name of the torrent based on the root path piece. | ||
534 | suggestedName :: LayoutInfo -> BS.ByteString | ||
535 | suggestedName (SingleFile FileInfo {..}) = fiName | ||
536 | suggestedName MultiFile {..} = liDirName | ||
537 | {-# INLINE suggestedName #-} | ||
538 | |||
539 | -- | Find sum of sizes of the all torrent files. | ||
540 | contentLength :: LayoutInfo -> FileSize | ||
541 | contentLength SingleFile { liFile = FileInfo {..} } = fiLength | ||
542 | contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs) | ||
543 | |||
544 | -- | Get number of all files in torrent. | ||
545 | fileCount :: LayoutInfo -> Int | ||
546 | fileCount SingleFile {..} = 1 | ||
547 | fileCount MultiFile {..} = L.length liFiles | ||
548 | |||
549 | -- | Find number of blocks of the specified size. If torrent size is | ||
550 | -- not a multiple of block size then the count is rounded up. | ||
551 | blockCount :: Int -> LayoutInfo -> Int | ||
552 | blockCount blkSize ci = contentLength ci `sizeInBase` blkSize | ||
553 | |||
554 | ------------------------------------------------------------------------ | ||
555 | |||
556 | -- | File layout specifies the order and the size of each file in the | ||
557 | -- storage. Note that order of files is highly important since we | ||
558 | -- coalesce all the files in the given order to get the linear block | ||
559 | -- address space. | ||
560 | -- | ||
561 | type FileLayout a = [(FilePath, a)] | ||
562 | |||
563 | -- | Extract files layout from torrent info with the given root path. | ||
564 | flatLayout | ||
565 | :: FilePath -- ^ Root path for the all torrent files. | ||
566 | -> LayoutInfo -- ^ Torrent content information. | ||
567 | -> FileLayout FileSize -- ^ The all file paths prefixed with the given root. | ||
568 | flatLayout prefixPath SingleFile { liFile = FileInfo {..} } | ||
569 | = [(prefixPath </> BC.unpack fiName, fiLength)] | ||
570 | flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles | ||
571 | where -- TODO use utf8 encoding in name | ||
572 | mkPath FileInfo {..} = (_path, fiLength) | ||
573 | where | ||
574 | _path = prefixPath </> BC.unpack liDirName | ||
575 | </> joinPath (L.map BC.unpack fiName) | ||
576 | |||
577 | -- | Calculate offset of each file based on its length, incrementally. | ||
578 | accumPositions :: FileLayout FileSize -> FileLayout (FileOffset, FileSize) | ||
579 | accumPositions = go 0 | ||
580 | where | ||
581 | go !_ [] = [] | ||
582 | go !offset ((n, s) : xs) = (n, (offset, s)) : go (offset + s) xs | ||
583 | |||
584 | -- | Gives global offset of a content file for a given full path. | ||
585 | fileOffset :: FilePath -> FileLayout FileOffset -> Maybe FileOffset | ||
586 | fileOffset = L.lookup | ||
587 | {-# INLINE fileOffset #-} | ||
588 | |||
589 | ------------------------------------------------------------------------ | ||
590 | |||
591 | -- | Divide and round up. | ||
592 | sizeInBase :: Integral a => a -> Int -> Int | ||
593 | sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align | ||
594 | where | ||
595 | align = if n `mod` fromIntegral b == 0 then 0 else 1 | ||
596 | {-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-} | ||
597 | {-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-} | ||
598 | |||
599 | {----------------------------------------------------------------------- | ||
600 | -- Piece attributes | ||
601 | -----------------------------------------------------------------------} | ||
602 | |||
603 | -- | Zero-based index of piece in torrent content. | ||
604 | type PieceIx = Int | ||
605 | |||
606 | -- | Size of piece in bytes. Should be a power of 2. | ||
607 | -- | ||
608 | -- NOTE: Have max and min size constrained to wide used | ||
609 | -- semi-standard values. This bounds should be used to make decision | ||
610 | -- about piece size for new torrents. | ||
611 | -- | ||
612 | type PieceSize = Int | ||
613 | |||
614 | -- | Number of pieces in torrent or a part of torrent. | ||
615 | type PieceCount = Int | ||
616 | |||
617 | defaultBlockSize :: Int | ||
618 | defaultBlockSize = 16 * 1024 | ||
619 | |||
620 | -- | Optimal number of pieces in torrent. | ||
621 | optimalPieceCount :: PieceCount | ||
622 | optimalPieceCount = 1000 | ||
623 | {-# INLINE optimalPieceCount #-} | ||
624 | |||
625 | -- | Piece size should not be less than this value. | ||
626 | minPieceSize :: Int | ||
627 | minPieceSize = defaultBlockSize * 4 | ||
628 | {-# INLINE minPieceSize #-} | ||
629 | |||
630 | -- | To prevent transfer degradation piece size should not exceed this | ||
631 | -- value. | ||
632 | maxPieceSize :: Int | ||
633 | maxPieceSize = 4 * 1024 * 1024 | ||
634 | {-# INLINE maxPieceSize #-} | ||
635 | |||
636 | toPow2 :: Int -> Int | ||
637 | #ifdef VERSION_bits_extras | ||
638 | toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x) | ||
639 | #else | ||
640 | -- base >= 4.8.0.0 | ||
641 | toPow2 x = bit $ fromIntegral (countLeadingZeros (0 :: Int) - countLeadingZeros x) | ||
642 | #endif | ||
643 | |||
644 | -- | Find the optimal piece size for a given torrent size. | ||
645 | defaultPieceSize :: Int64 -> Int | ||
646 | defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc | ||
647 | where | ||
648 | pc = fromIntegral (x `div` fromIntegral optimalPieceCount) | ||
649 | |||
650 | {----------------------------------------------------------------------- | ||
651 | -- Piece data | ||
652 | -----------------------------------------------------------------------} | ||
653 | |||
654 | type PieceHash = BS.ByteString | ||
655 | |||
656 | hashsize :: Int | ||
657 | hashsize = 20 | ||
658 | {-# INLINE hashsize #-} | ||
659 | |||
660 | -- TODO check if pieceLength is power of 2 | ||
661 | -- | Piece payload should be strict or lazy bytestring. | ||
662 | data Piece a = Piece | ||
663 | { -- | Zero-based piece index in torrent. | ||
664 | pieceIndex :: {-# UNPACK #-} !PieceIx | ||
665 | |||
666 | -- | Payload. | ||
667 | , pieceData :: !a | ||
668 | } deriving (Show, Read, Eq, Functor, Typeable) | ||
669 | |||
670 | instance NFData a => NFData (Piece a) where | ||
671 | rnf (Piece a b) = rnf a `seq` rnf b | ||
672 | |||
673 | -- | Payload bytes are omitted. | ||
674 | instance Pretty (Piece a) where | ||
675 | pPrint Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) | ||
676 | |||
677 | -- | Get size of piece in bytes. | ||
678 | pieceSize :: Piece BL.ByteString -> PieceSize | ||
679 | pieceSize Piece {..} = fromIntegral (BL.length pieceData) | ||
680 | |||
681 | -- | Get piece hash. | ||
682 | hashPiece :: Piece BL.ByteString -> PieceHash | ||
683 | hashPiece Piece {..} = Bytes.convert (hashlazy pieceData :: Digest SHA1) | ||
684 | |||
685 | {----------------------------------------------------------------------- | ||
686 | -- Piece control | ||
687 | -----------------------------------------------------------------------} | ||
688 | |||
689 | -- | A flat array of SHA1 hash for each piece. | ||
690 | newtype HashList = HashList { unHashList :: BS.ByteString } | ||
691 | deriving ( Show, Read, Eq, Typeable | ||
692 | #ifdef VERSION_bencoding | ||
693 | , BEncode | ||
694 | #endif | ||
695 | ) | ||
696 | |||
697 | -- | Empty hash list. | ||
698 | instance Default HashList where | ||
699 | def = HashList "" | ||
700 | |||
701 | -- | Part of torrent file used for torrent content validation. | ||
702 | data PieceInfo = PieceInfo | ||
703 | { piPieceLength :: {-# UNPACK #-} !PieceSize | ||
704 | -- ^ Number of bytes in each piece. | ||
705 | |||
706 | , piPieceHashes :: !HashList | ||
707 | -- ^ Concatenation of all 20-byte SHA1 hash values. | ||
708 | } deriving (Show, Read, Eq, Typeable) | ||
709 | |||
710 | #ifdef USE_lens | ||
711 | -- | Number of bytes in each piece. | ||
712 | makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo | ||
713 | |||
714 | -- | Concatenation of all 20-byte SHA1 hash values. | ||
715 | makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo | ||
716 | #endif | ||
717 | |||
718 | instance NFData PieceInfo where | ||
719 | rnf (PieceInfo a (HashList b)) = rnf a `seq` rnf b | ||
720 | |||
721 | instance Default PieceInfo where | ||
722 | def = PieceInfo 1 def | ||
723 | |||
724 | |||
725 | #ifdef VERSION_bencoding | ||
726 | putPieceInfo :: Data.Torrent.Put PieceInfo | ||
727 | putPieceInfo PieceInfo {..} cont = | ||
728 | "piece length" .=! piPieceLength | ||
729 | .: "pieces" .=! piPieceHashes | ||
730 | .: cont | ||
731 | |||
732 | getPieceInfo :: BE.Get PieceInfo | ||
733 | getPieceInfo = do | ||
734 | PieceInfo <$>! "piece length" | ||
735 | <*>! "pieces" | ||
736 | |||
737 | instance BEncode PieceInfo where | ||
738 | toBEncode = toDict . (`putPieceInfo` endDict) | ||
739 | fromBEncode = fromDict getPieceInfo | ||
740 | #endif | ||
741 | |||
742 | -- | Hashes are omitted. | ||
743 | instance Pretty PieceInfo where | ||
744 | pPrint PieceInfo {..} = "Piece size: " <> int piPieceLength | ||
745 | |||
746 | slice :: Int -> Int -> BS.ByteString -> BS.ByteString | ||
747 | slice start len = BS.take len . BS.drop start | ||
748 | {-# INLINE slice #-} | ||
749 | |||
750 | -- | Extract validation hash by specified piece index. | ||
751 | pieceHash :: PieceInfo -> PieceIx -> PieceHash | ||
752 | pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashList piPieceHashes) | ||
753 | |||
754 | -- | Find count of pieces in the torrent. If torrent size is not a | ||
755 | -- multiple of piece size then the count is rounded up. | ||
756 | pieceCount :: PieceInfo -> PieceCount | ||
757 | pieceCount PieceInfo {..} = BS.length (unHashList piPieceHashes) `quot` hashsize | ||
758 | |||
759 | -- | Test if this is last piece in torrent content. | ||
760 | isLastPiece :: PieceInfo -> PieceIx -> Bool | ||
761 | isLastPiece ci i = pieceCount ci == succ i | ||
762 | |||
763 | -- | Validate piece with metainfo hash. | ||
764 | checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool | ||
765 | checkPieceLazy pinfo @ PieceInfo {..} Piece {..} | ||
766 | = (fromIntegral (BL.length pieceData) == piPieceLength | ||
767 | || isLastPiece pinfo pieceIndex) | ||
768 | && Bytes.convert (hashlazy pieceData :: Digest SHA1) == pieceHash pinfo pieceIndex | ||
769 | |||
770 | {----------------------------------------------------------------------- | ||
771 | -- Info dictionary | ||
772 | -----------------------------------------------------------------------} | ||
773 | |||
774 | {- note that info hash is actually reduntant field | ||
775 | but it's better to keep it here to avoid heavy recomputations | ||
776 | -} | ||
777 | |||
778 | -- | Info part of the .torrent file contain info about each content file. | ||
779 | data InfoDict = InfoDict | ||
780 | { idInfoHash :: !InfoHash | ||
781 | -- ^ SHA1 hash of the (other) 'DictInfo' fields. | ||
782 | |||
783 | , idLayoutInfo :: !LayoutInfo | ||
784 | -- ^ File layout (name, size, etc) information. | ||
785 | |||
786 | , idPieceInfo :: !PieceInfo | ||
787 | -- ^ Content validation information. | ||
788 | |||
789 | , idPrivate :: !Bool | ||
790 | -- ^ If set the client MUST publish its presence to get other | ||
791 | -- peers ONLY via the trackers explicity described in the | ||
792 | -- metainfo file. | ||
793 | -- | ||
794 | -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html> | ||
795 | } deriving (Show, Read, Eq, Typeable) | ||
796 | |||
797 | #ifdef USE_lens | ||
798 | makeLensesFor | ||
799 | [ ("idInfoHash" , "infohash" ) | ||
800 | , ("idLayoutInfo", "layoutInfo") | ||
801 | , ("idPieceInfo" , "pieceInfo" ) | ||
802 | , ("idPrivate" , "isPrivate" ) | ||
803 | ] | ||
804 | ''InfoDict | ||
805 | #endif | ||
806 | |||
807 | instance NFData InfoDict where | ||
808 | rnf InfoDict {..} = rnf idLayoutInfo | ||
809 | |||
810 | instance Hashable InfoDict where | ||
811 | hashWithSalt = Hashable.hashUsing idInfoHash | ||
812 | {-# INLINE hashWithSalt #-} | ||
813 | |||
814 | -- | Hash lazy bytestring using SHA1 algorithm. | ||
815 | hashLazyIH :: BL.ByteString -> InfoHash | ||
816 | hashLazyIH = either (const (error msg)) id . safeConvert . (Bytes.convert :: Digest SHA1 -> BS.ByteString) . hashlazy | ||
817 | where | ||
818 | msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long" | ||
819 | |||
820 | #ifdef VERSION_bencoding | ||
821 | -- | Empty info dictionary with zero-length content. | ||
822 | instance Default InfoDict where | ||
823 | def = infoDictionary def def False | ||
824 | |||
825 | -- | Smart constructor: add a info hash to info dictionary. | ||
826 | infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict | ||
827 | infoDictionary li pinfo private = InfoDict ih li pinfo private | ||
828 | where | ||
829 | ih = hashLazyIH $ BE.encode $ InfoDict def li pinfo private | ||
830 | |||
831 | getPrivate :: BE.Get Bool | ||
832 | getPrivate = (Just True ==) <$>? "private" | ||
833 | |||
834 | putPrivate :: Bool -> BDict -> BDict | ||
835 | putPrivate False = id | ||
836 | putPrivate True = \ cont -> "private" .=! True .: cont | ||
837 | |||
838 | instance BEncode InfoDict where | ||
839 | toBEncode InfoDict {..} = toDict $ | ||
840 | putLayoutInfo idLayoutInfo $ | ||
841 | putPieceInfo idPieceInfo $ | ||
842 | putPrivate idPrivate $ | ||
843 | endDict | ||
844 | |||
845 | fromBEncode dict = (`fromDict` dict) $ do | ||
846 | InfoDict ih <$> getLayoutInfo | ||
847 | <*> getPieceInfo | ||
848 | <*> getPrivate | ||
849 | where | ||
850 | ih = hashLazyIH (BE.encode dict) | ||
851 | #endif | ||
852 | |||
853 | ppPrivacy :: Bool -> Doc | ||
854 | ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public" | ||
855 | |||
856 | --ppAdditionalInfo :: InfoDict -> Doc | ||
857 | --ppAdditionalInfo layout = PP.empty | ||
858 | |||
859 | instance Pretty InfoDict where | ||
860 | pPrint InfoDict {..} = | ||
861 | pPrint idLayoutInfo $$ | ||
862 | pPrint idPieceInfo $$ | ||
863 | ppPrivacy idPrivate | ||
864 | |||
865 | {----------------------------------------------------------------------- | ||
866 | -- Torrent info | ||
867 | -----------------------------------------------------------------------} | ||
868 | -- TODO add torrent file validation | ||
869 | |||
870 | -- | Metainfo about particular torrent. | ||
871 | data Torrent = Torrent | ||
872 | { tAnnounce :: !(Maybe URI) | ||
873 | -- ^ The URL of the tracker. | ||
874 | |||
875 | , tAnnounceList :: !(Maybe [[URI]]) | ||
876 | -- ^ Announce list add multiple tracker support. | ||
877 | -- | ||
878 | -- BEP 12: <http://www.bittorrent.org/beps/bep_0012.html> | ||
879 | |||
880 | , tComment :: !(Maybe Text) | ||
881 | -- ^ Free-form comments of the author. | ||
882 | |||
883 | , tCreatedBy :: !(Maybe Text) | ||
884 | -- ^ Name and version of the program used to create the .torrent. | ||
885 | |||
886 | , tCreationDate :: !(Maybe POSIXTime) | ||
887 | -- ^ Creation time of the torrent, in standard UNIX epoch. | ||
888 | |||
889 | , tEncoding :: !(Maybe Text) | ||
890 | -- ^ String encoding format used to generate the pieces part of | ||
891 | -- the info dictionary in the .torrent metafile. | ||
892 | |||
893 | , tInfoDict :: !InfoDict | ||
894 | -- ^ Info about each content file. | ||
895 | |||
896 | , tNodes :: !(Maybe [NodeAddr HostName]) | ||
897 | -- ^ This key should be set to the /K closest/ nodes in the | ||
898 | -- torrent generating client's routing table. Alternatively, the | ||
899 | -- key could be set to a known good 'Network.Address.Node' | ||
900 | -- such as one operated by the person generating the torrent. | ||
901 | -- | ||
902 | -- Please do not automatically add \"router.bittorrent.com\" to | ||
903 | -- this list because different bittorrent software may prefer to | ||
904 | -- use different bootstrap node. | ||
905 | |||
906 | , tPublisher :: !(Maybe URI) | ||
907 | -- ^ Containing the RSA public key of the publisher of the | ||
908 | -- torrent. Private counterpart of this key that has the | ||
909 | -- authority to allow new peers onto the swarm. | ||
910 | |||
911 | , tPublisherURL :: !(Maybe URI) | ||
912 | , tSignature :: !(Maybe BS.ByteString) | ||
913 | -- ^ The RSA signature of the info dictionary (specifically, the | ||
914 | -- encrypted SHA-1 hash of the info dictionary). | ||
915 | } deriving (Show, Eq, Typeable) | ||
916 | |||
917 | #ifdef USE_lens | ||
918 | makeLensesFor | ||
919 | [ ("tAnnounce" , "announce" ) | ||
920 | , ("tAnnounceList", "announceList") | ||
921 | , ("tComment" , "comment" ) | ||
922 | , ("tCreatedBy" , "createdBy" ) | ||
923 | , ("tCreationDate", "creationDate") | ||
924 | , ("tEncoding" , "encoding" ) | ||
925 | , ("tInfoDict" , "infoDict" ) | ||
926 | , ("tPublisher" , "publisher" ) | ||
927 | , ("tPublisherURL", "publisherURL") | ||
928 | , ("tSignature" , "signature" ) | ||
929 | ] | ||
930 | ''Torrent | ||
931 | #endif | ||
932 | |||
933 | instance NFData Torrent where | ||
934 | rnf Torrent {..} = rnf tInfoDict | ||
935 | |||
936 | #ifdef VERSION_bencoding | ||
937 | -- TODO move to bencoding | ||
938 | instance BEncode URI where | ||
939 | toBEncode uri = toBEncode (BC.pack (uriToString id uri "")) | ||
940 | {-# INLINE toBEncode #-} | ||
941 | |||
942 | fromBEncode (BString s) | Just url <- parseURI (BC.unpack s) = return url | ||
943 | fromBEncode b = decodingError $ "url <" ++ show b ++ ">" | ||
944 | {-# INLINE fromBEncode #-} | ||
945 | |||
946 | --pico2uni :: Pico -> Uni | ||
947 | --pico2uni = undefined | ||
948 | |||
949 | -- TODO move to bencoding | ||
950 | instance BEncode POSIXTime where | ||
951 | toBEncode pt = toBEncode (floor pt :: Integer) | ||
952 | fromBEncode (BInteger i) = return $ fromIntegral i | ||
953 | fromBEncode _ = decodingError $ "POSIXTime" | ||
954 | |||
955 | -- TODO to bencoding package | ||
956 | instance {-# OVERLAPPING #-} BEncode String where | ||
957 | toBEncode = toBEncode . T.pack | ||
958 | fromBEncode v = T.unpack <$> fromBEncode v | ||
959 | {- | ||
960 | instance {-# OVERLAPPING #-} BEncode HostName where | ||
961 | toBEncode = toBEncode . T.pack | ||
962 | fromBEncode v = T.unpack <$> fromBEncode v | ||
963 | -} | ||
964 | |||
965 | instance BEncode Torrent where | ||
966 | toBEncode Torrent {..} = toDict $ | ||
967 | "announce" .=? tAnnounce | ||
968 | .: "announce-list" .=? tAnnounceList | ||
969 | .: "comment" .=? tComment | ||
970 | .: "created by" .=? tCreatedBy | ||
971 | .: "creation date" .=? tCreationDate | ||
972 | .: "encoding" .=? tEncoding | ||
973 | .: "info" .=! tInfoDict | ||
974 | .: "nodes" .=? tNodes | ||
975 | .: "publisher" .=? tPublisher | ||
976 | .: "publisher-url" .=? tPublisherURL | ||
977 | .: "signature" .=? tSignature | ||
978 | .: endDict | ||
979 | |||
980 | fromBEncode = fromDict $ do | ||
981 | Torrent <$>? "announce" | ||
982 | <*>? "announce-list" | ||
983 | <*>? "comment" | ||
984 | <*>? "created by" | ||
985 | <*>? "creation date" | ||
986 | <*>? "encoding" | ||
987 | <*>! "info" | ||
988 | <*>? "nodes" | ||
989 | <*>? "publisher" | ||
990 | <*>? "publisher-url" | ||
991 | <*>? "signature" | ||
992 | #endif | ||
993 | |||
994 | (<:>) :: Doc -> Doc -> Doc | ||
995 | name <:> v = name <> ":" <+> v | ||
996 | |||
997 | (<:>?) :: Doc -> Maybe Doc -> Doc | ||
998 | _ <:>? Nothing = PP.empty | ||
999 | name <:>? (Just d) = name <:> d | ||
1000 | |||
1001 | instance Pretty Torrent where | ||
1002 | pPrint Torrent {..} = | ||
1003 | "InfoHash: " <> pPrint (idInfoHash tInfoDict) | ||
1004 | $$ hang "General" 4 generalInfo | ||
1005 | $$ hang "Tracker" 4 trackers | ||
1006 | $$ pPrint tInfoDict | ||
1007 | where | ||
1008 | trackers = case tAnnounceList of | ||
1009 | Nothing -> text (show tAnnounce) | ||
1010 | Just xxs -> vcat $ L.map ppTier $ L.zip [1..] xxs | ||
1011 | where | ||
1012 | ppTier (n, xs) = "Tier #" <> int n <:> vcat (L.map (text . show) xs) | ||
1013 | |||
1014 | generalInfo = | ||
1015 | "Comment" <:>? ((text . T.unpack) <$> tComment) $$ | ||
1016 | "Created by" <:>? ((text . T.unpack) <$> tCreatedBy) $$ | ||
1017 | "Created on" <:>? ((text . show . posixSecondsToUTCTime) | ||
1018 | <$> tCreationDate) $$ | ||
1019 | "Encoding" <:>? ((text . T.unpack) <$> tEncoding) $$ | ||
1020 | "Publisher" <:>? ((text . show) <$> tPublisher) $$ | ||
1021 | "Publisher URL" <:>? ((text . show) <$> tPublisherURL) $$ | ||
1022 | "Signature" <:>? ((text . show) <$> tSignature) | ||
1023 | |||
1024 | #ifdef VERSION_bencoding | ||
1025 | -- | No files, no trackers, no nodes, etc... | ||
1026 | instance Default Torrent where | ||
1027 | def = nullTorrent def | ||
1028 | #endif | ||
1029 | |||
1030 | -- | A simple torrent contains only required fields. | ||
1031 | nullTorrent :: InfoDict -> Torrent | ||
1032 | nullTorrent info = Torrent | ||
1033 | Nothing Nothing Nothing Nothing Nothing Nothing | ||
1034 | info Nothing Nothing Nothing Nothing | ||
1035 | |||
1036 | -- | Mime type of torrent files. | ||
1037 | typeTorrent :: BS.ByteString | ||
1038 | typeTorrent = "application/x-bittorrent" | ||
1039 | |||
1040 | -- | Extension usually used for torrent files. | ||
1041 | torrentExt :: String | ||
1042 | torrentExt = "torrent" | ||
1043 | |||
1044 | -- | Test if this path has proper extension. | ||
1045 | isTorrentPath :: FilePath -> Bool | ||
1046 | isTorrentPath filepath = takeExtension filepath == extSeparator : torrentExt | ||
1047 | |||
1048 | #ifdef VERSION_bencoding | ||
1049 | -- | Read and decode a .torrent file. | ||
1050 | fromFile :: FilePath -> IO Torrent | ||
1051 | fromFile filepath = do | ||
1052 | contents <- BS.readFile filepath | ||
1053 | case BE.decode contents of | ||
1054 | Right !t -> return t | ||
1055 | Left msg -> throwIO $ userError $ msg ++ " while reading torrent file" | ||
1056 | |||
1057 | -- | Encode and write a .torrent file. | ||
1058 | toFile :: FilePath -> Torrent -> IO () | ||
1059 | toFile filepath = BL.writeFile filepath . BE.encode | ||
1060 | #endif | ||
1061 | |||
1062 | {----------------------------------------------------------------------- | ||
1063 | -- URN | ||
1064 | -----------------------------------------------------------------------} | ||
1065 | |||
1066 | -- | Namespace identifier determines the syntactic interpretation of | ||
1067 | -- namespace-specific string. | ||
1068 | type NamespaceId = [Text] | ||
1069 | |||
1070 | -- | BitTorrent Info Hash (hence the name) namespace | ||
1071 | -- identifier. Namespace-specific string /should/ be a base16\/base32 | ||
1072 | -- encoded SHA1 hash of the corresponding torrent /info/ dictionary. | ||
1073 | -- | ||
1074 | btih :: NamespaceId | ||
1075 | btih = ["btih"] | ||
1076 | |||
1077 | -- | URN is pesistent location-independent identifier for | ||
1078 | -- resources. In particular, URNs are used represent torrent names | ||
1079 | -- as a part of magnet link, see 'Data.Torrent.Magnet.Magnet' for | ||
1080 | -- more info. | ||
1081 | -- | ||
1082 | data URN = URN | ||
1083 | { urnNamespace :: NamespaceId -- ^ a namespace identifier; | ||
1084 | , urnString :: Text -- ^ a corresponding | ||
1085 | -- namespace-specific string. | ||
1086 | } deriving (Eq, Ord, Typeable) | ||
1087 | |||
1088 | ----------------------------------------------------------------------- | ||
1089 | |||
1090 | instance Convertible URN InfoHash where | ||
1091 | safeConvert u @ URN {..} | ||
1092 | | urnNamespace /= btih = convError "invalid namespace" u | ||
1093 | | otherwise = safeConvert urnString | ||
1094 | |||
1095 | -- | Make resource name for torrent with corresponding | ||
1096 | -- infohash. Infohash is base16 (hex) encoded. | ||
1097 | -- | ||
1098 | infohashURN :: InfoHash -> URN | ||
1099 | infohashURN = URN btih . longHex | ||
1100 | |||
1101 | -- | Meaningless placeholder value. | ||
1102 | instance Default URN where | ||
1103 | def = infohashURN def | ||
1104 | |||
1105 | ------------------------------------------------------------------------ | ||
1106 | |||
1107 | -- | Render URN to its text representation. | ||
1108 | renderURN :: URN -> Text | ||
1109 | renderURN URN {..} | ||
1110 | = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString] | ||
1111 | |||
1112 | instance Pretty URN where | ||
1113 | pPrint = text . T.unpack . renderURN | ||
1114 | |||
1115 | instance Show URN where | ||
1116 | showsPrec n = showsPrec n . T.unpack . renderURN | ||
1117 | |||
1118 | instance QueryValueLike URN where | ||
1119 | toQueryValue = toQueryValue . renderURN | ||
1120 | {-# INLINE toQueryValue #-} | ||
1121 | |||
1122 | ----------------------------------------------------------------------- | ||
1123 | |||
1124 | _unsnoc :: [a] -> Maybe ([a], a) | ||
1125 | _unsnoc [] = Nothing | ||
1126 | _unsnoc xs = Just (L.init xs, L.last xs) | ||
1127 | |||
1128 | instance Convertible Text URN where | ||
1129 | safeConvert t = case T.split (== ':') t of | ||
1130 | uriScheme : body | ||
1131 | | T.toLower uriScheme == "urn" -> | ||
1132 | case _unsnoc body of | ||
1133 | Just (namespace, val) -> pure URN | ||
1134 | { urnNamespace = namespace | ||
1135 | , urnString = val | ||
1136 | } | ||
1137 | Nothing -> convError "missing URN string" body | ||
1138 | | otherwise -> convError "invalid URN scheme" uriScheme | ||
1139 | [] -> convError "missing URN scheme" t | ||
1140 | |||
1141 | instance IsString URN where | ||
1142 | fromString = either (error . prettyConvertError) id | ||
1143 | . safeConvert . T.pack | ||
1144 | |||
1145 | -- | Try to parse an URN from its text representation. | ||
1146 | -- | ||
1147 | -- Use 'safeConvert' for detailed error messages. | ||
1148 | -- | ||
1149 | parseURN :: Text -> Maybe URN | ||
1150 | parseURN = either (const Nothing) pure . safeConvert | ||
1151 | |||
1152 | {----------------------------------------------------------------------- | ||
1153 | -- Magnet | ||
1154 | -----------------------------------------------------------------------} | ||
1155 | -- $magnet-link | ||
1156 | -- | ||
1157 | -- Magnet URI scheme is an standard defining Magnet links. Magnet | ||
1158 | -- links are refer to resources by hash, in particular magnet links | ||
1159 | -- can refer to torrent using corresponding infohash. In this way, | ||
1160 | -- magnet links can be used instead of torrent files. | ||
1161 | -- | ||
1162 | -- This module provides bittorrent specific implementation of magnet | ||
1163 | -- links. | ||
1164 | -- | ||
1165 | -- For generic magnet uri scheme see: | ||
1166 | -- <http://magnet-uri.sourceforge.net/magnet-draft-overview.txt>, | ||
1167 | -- <http://www.iana.org/assignments/uri-schemes/prov/magnet> | ||
1168 | -- | ||
1169 | -- Bittorrent specific details: | ||
1170 | -- <http://www.bittorrent.org/beps/bep_0009.html> | ||
1171 | -- | ||
1172 | |||
1173 | -- TODO multiple exact topics | ||
1174 | -- TODO render/parse supplement for URI/query | ||
1175 | |||
1176 | -- | An URI used to identify torrent. | ||
1177 | data Magnet = Magnet | ||
1178 | { -- | Torrent infohash hash. Can be used in DHT queries if no | ||
1179 | -- 'tracker' provided. | ||
1180 | exactTopic :: !InfoHash -- TODO InfoHash -> URN? | ||
1181 | |||
1182 | -- | A filename for the file to download. Can be used to | ||
1183 | -- display name while waiting for metadata. | ||
1184 | , displayName :: Maybe Text | ||
1185 | |||
1186 | -- | Size of the resource in bytes. | ||
1187 | , exactLength :: Maybe Integer | ||
1188 | |||
1189 | -- | URI pointing to manifest, e.g. a list of further items. | ||
1190 | , manifest :: Maybe Text | ||
1191 | |||
1192 | -- | Search string. | ||
1193 | , keywordTopic :: Maybe Text | ||
1194 | |||
1195 | -- | A source to be queried after not being able to find and | ||
1196 | -- download the file in the bittorrent network in a defined | ||
1197 | -- amount of time. | ||
1198 | , acceptableSource :: Maybe URI | ||
1199 | |||
1200 | -- | Direct link to the resource. | ||
1201 | , exactSource :: Maybe URI | ||
1202 | |||
1203 | -- | URI to the tracker. | ||
1204 | , tracker :: Maybe URI | ||
1205 | |||
1206 | -- | Additional or experimental parameters. | ||
1207 | , supplement :: Map Text Text | ||
1208 | } deriving (Eq, Ord, Typeable) | ||
1209 | |||
1210 | instance QueryValueLike Integer where | ||
1211 | toQueryValue = toQueryValue . show | ||
1212 | |||
1213 | instance QueryValueLike URI where | ||
1214 | toQueryValue = toQueryValue . show | ||
1215 | |||
1216 | instance QueryLike Magnet where | ||
1217 | toQuery Magnet {..} = | ||
1218 | [ ("xt", toQueryValue $ infohashURN exactTopic) | ||
1219 | , ("dn", toQueryValue displayName) | ||
1220 | , ("xl", toQueryValue exactLength) | ||
1221 | , ("mt", toQueryValue manifest) | ||
1222 | , ("kt", toQueryValue keywordTopic) | ||
1223 | , ("as", toQueryValue acceptableSource) | ||
1224 | , ("xs", toQueryValue exactSource) | ||
1225 | , ("tr", toQueryValue tracker) | ||
1226 | ] | ||
1227 | |||
1228 | instance QueryValueLike Magnet where | ||
1229 | toQueryValue = toQueryValue . renderMagnet | ||
1230 | |||
1231 | instance Convertible QueryText Magnet where | ||
1232 | safeConvert xs = do | ||
1233 | urnStr <- getTextMsg "xt" "exact topic not defined" xs | ||
1234 | infoHash <- convertVia (error "safeConvert" :: URN) urnStr | ||
1235 | return Magnet | ||
1236 | { exactTopic = infoHash | ||
1237 | , displayName = getText "dn" xs | ||
1238 | , exactLength = getText "xl" xs >>= getInt | ||
1239 | , manifest = getText "mt" xs | ||
1240 | , keywordTopic = getText "kt" xs | ||
1241 | , acceptableSource = getText "as" xs >>= getURI | ||
1242 | , exactSource = getText "xs" xs >>= getURI | ||
1243 | , tracker = getText "tr" xs >>= getURI | ||
1244 | , supplement = M.empty | ||
1245 | } | ||
1246 | where | ||
1247 | getInt = either (const Nothing) (Just . fst) . signed decimal | ||
1248 | getURI = parseURI . T.unpack | ||
1249 | getText p = join . L.lookup p | ||
1250 | getTextMsg p msg ps = maybe (convError msg xs) pure $ getText p ps | ||
1251 | |||
1252 | magnetScheme :: URI | ||
1253 | magnetScheme = URI | ||
1254 | { uriScheme = "magnet:" | ||
1255 | , uriAuthority = Nothing | ||
1256 | , uriPath = "" | ||
1257 | , uriQuery = "" | ||
1258 | , uriFragment = "" | ||
1259 | } | ||
1260 | |||
1261 | isMagnetURI :: URI -> Bool | ||
1262 | isMagnetURI u = u { uriQuery = "" } == magnetScheme | ||
1263 | |||
1264 | -- | Can be used instead of 'parseMagnet'. | ||
1265 | instance Convertible URI Magnet where | ||
1266 | safeConvert u @ URI {..} | ||
1267 | | not (isMagnetURI u) = convError "this is not a magnet link" u | ||
1268 | | otherwise = safeConvert $ parseQueryText $ BC.pack uriQuery | ||
1269 | |||
1270 | -- | Can be used instead of 'renderMagnet'. | ||
1271 | instance Convertible Magnet URI where | ||
1272 | safeConvert m = pure $ magnetScheme | ||
1273 | { uriQuery = BC.unpack $ renderQuery True $ toQuery m } | ||
1274 | |||
1275 | instance Convertible String Magnet where | ||
1276 | safeConvert str | ||
1277 | | Just uri <- parseURI str = safeConvert uri | ||
1278 | | otherwise = convError "unable to parse uri" str | ||
1279 | |||
1280 | ------------------------------------------------------------------------ | ||
1281 | |||
1282 | -- | Meaningless placeholder value. | ||
1283 | instance Default Magnet where | ||
1284 | def = Magnet | ||
1285 | { exactTopic = def | ||
1286 | , displayName = Nothing | ||
1287 | , exactLength = Nothing | ||
1288 | , manifest = Nothing | ||
1289 | , keywordTopic = Nothing | ||
1290 | , acceptableSource = Nothing | ||
1291 | , exactSource = Nothing | ||
1292 | , tracker = Nothing | ||
1293 | , supplement = M.empty | ||
1294 | } | ||
1295 | |||
1296 | -- | Set 'exactTopic' ('xt' param) only, other params are empty. | ||
1297 | nullMagnet :: InfoHash -> Magnet | ||
1298 | nullMagnet u = Magnet | ||
1299 | { exactTopic = u | ||
1300 | , displayName = Nothing | ||
1301 | , exactLength = Nothing | ||
1302 | , manifest = Nothing | ||
1303 | , keywordTopic = Nothing | ||
1304 | , acceptableSource = Nothing | ||
1305 | , exactSource = Nothing | ||
1306 | , tracker = Nothing | ||
1307 | , supplement = M.empty | ||
1308 | } | ||
1309 | |||
1310 | -- | Like 'nullMagnet' but also include 'displayName' ('dn' param). | ||
1311 | simpleMagnet :: Torrent -> Magnet | ||
1312 | simpleMagnet Torrent {tInfoDict = InfoDict {..}} | ||
1313 | = (nullMagnet idInfoHash) | ||
1314 | { displayName = Just $ T.decodeUtf8 $ suggestedName idLayoutInfo | ||
1315 | } | ||
1316 | |||
1317 | -- | Like 'simpleMagnet' but also include 'exactLength' ('xl' param) and | ||
1318 | -- 'tracker' ('tr' param). | ||
1319 | -- | ||
1320 | detailedMagnet :: Torrent -> Magnet | ||
1321 | detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce} | ||
1322 | = (simpleMagnet t) | ||
1323 | { exactLength = Just $ fromIntegral $ contentLength idLayoutInfo | ||
1324 | , tracker = tAnnounce | ||
1325 | } | ||
1326 | |||
1327 | ----------------------------------------------------------------------- | ||
1328 | |||
1329 | parseMagnetStr :: String -> Maybe Magnet | ||
1330 | parseMagnetStr = either (const Nothing) Just . safeConvert | ||
1331 | |||
1332 | renderMagnetStr :: Magnet -> String | ||
1333 | renderMagnetStr = show . (convert :: Magnet -> URI) | ||
1334 | |||
1335 | instance Pretty Magnet where | ||
1336 | pPrint = PP.text . renderMagnetStr | ||
1337 | |||
1338 | instance Show Magnet where | ||
1339 | show = renderMagnetStr | ||
1340 | {-# INLINE show #-} | ||
1341 | |||
1342 | instance Read Magnet where | ||
1343 | readsPrec _ xs | ||
1344 | | Just m <- parseMagnetStr mstr = [(m, rest)] | ||
1345 | | otherwise = [] | ||
1346 | where | ||
1347 | (mstr, rest) = L.break (== ' ') xs | ||
1348 | |||
1349 | instance IsString Magnet where | ||
1350 | fromString str = fromMaybe (error msg) $ parseMagnetStr str | ||
1351 | where | ||
1352 | msg = "unable to parse magnet: " ++ str | ||
1353 | |||
1354 | -- | Try to parse magnet link from urlencoded string. Use | ||
1355 | -- 'safeConvert' to find out error location. | ||
1356 | -- | ||
1357 | parseMagnet :: Text -> Maybe Magnet | ||
1358 | parseMagnet = parseMagnetStr . T.unpack | ||
1359 | {-# INLINE parseMagnet #-} | ||
1360 | |||
1361 | -- | Render magnet link to urlencoded string | ||
1362 | renderMagnet :: Magnet -> Text | ||
1363 | renderMagnet = T.pack . renderMagnetStr | ||
1364 | {-# INLINE renderMagnet #-} | ||