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