diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/Torrent.hs | 89 |
1 files changed, 44 insertions, 45 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index ba71d334..7c56edf7 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -144,38 +144,37 @@ module Data.Torrent | |||
144 | , renderURN | 144 | , renderURN |
145 | ) where | 145 | ) where |
146 | 146 | ||
147 | import Prelude hiding (sum) | 147 | import Prelude |
148 | import Control.Applicative | 148 | import Control.Applicative |
149 | import Control.DeepSeq | 149 | import Control.DeepSeq |
150 | import Control.Exception | 150 | import Control.Exception |
151 | import Control.Lens hiding (unsnoc) | 151 | import Control.Lens |
152 | import Control.Monad | 152 | import Control.Monad |
153 | import qualified Crypto.Hash.SHA1 as C | 153 | import Crypto.Hash.SHA1 as SHA1 |
154 | import qualified Crypto.Hash.SHA1 as SHA1 | ||
155 | import Data.BEncode as BE | 154 | import Data.BEncode as BE |
156 | import Data.BEncode.Types as BE | 155 | import Data.BEncode.Types as BE |
157 | import Data.Bits | 156 | import Data.Bits |
158 | import Data.Bits.Extras | 157 | import Data.Bits.Extras |
159 | import Data.ByteString as BS | 158 | import Data.ByteString as BS |
160 | import Data.ByteString.Base16 as Base16 | 159 | import Data.ByteString.Base16 as Base16 |
161 | import Data.ByteString.Base32 as Base32 | 160 | import Data.ByteString.Base32 as Base32 |
162 | import Data.ByteString.Base64 as Base64 | 161 | import Data.ByteString.Base64 as Base64 |
163 | import qualified Data.ByteString.Char8 as BC (pack, unpack) | 162 | import Data.ByteString.Char8 as BC (pack, unpack) |
164 | import qualified Data.ByteString.Lazy as BL | 163 | import Data.ByteString.Lazy as BL |
165 | import Data.Char | 164 | import Data.Char |
166 | import Data.Convertible | 165 | import Data.Convertible |
167 | import Data.Default | 166 | import Data.Default |
168 | import Data.Foldable as F | 167 | import Data.Foldable as F |
169 | import Data.Hashable as Hashable | 168 | import Data.Hashable as Hashable |
170 | import Data.Int | 169 | import Data.Int |
171 | import qualified Data.List as L | 170 | import Data.List as L |
172 | import Data.Map as M | 171 | import Data.Map as M |
173 | import Data.Maybe | 172 | import Data.Maybe |
174 | import Data.Serialize as S | 173 | import Data.Serialize as S |
175 | import Data.String | 174 | import Data.String |
176 | import Data.Text as T | 175 | import Data.Text as T |
177 | import Data.Text.Encoding as T | 176 | import Data.Text.Encoding as T |
178 | import Data.Text.Read | 177 | import Data.Text.Read |
179 | import Data.Time.Clock.POSIX | 178 | import Data.Time.Clock.POSIX |
180 | import Data.Typeable | 179 | import Data.Typeable |
181 | import Network (HostName) | 180 | import Network (HostName) |
@@ -330,7 +329,7 @@ data FileInfo a = FileInfo { | |||
330 | -- ^ Length of the file in bytes. | 329 | -- ^ Length of the file in bytes. |
331 | 330 | ||
332 | -- TODO unpacked MD5 sum | 331 | -- TODO unpacked MD5 sum |
333 | , fiMD5Sum :: !(Maybe ByteString) | 332 | , fiMD5Sum :: !(Maybe BS.ByteString) |
334 | -- ^ 32 character long MD5 sum of the file. Used by third-party | 333 | -- ^ 32 character long MD5 sum of the file. Used by third-party |
335 | -- tools, not by bittorrent protocol itself. | 334 | -- tools, not by bittorrent protocol itself. |
336 | 335 | ||
@@ -361,7 +360,7 @@ instance NFData a => NFData (FileInfo a) where | |||
361 | rnf FileInfo {..} = rnf fiName | 360 | rnf FileInfo {..} = rnf fiName |
362 | {-# INLINE rnf #-} | 361 | {-# INLINE rnf #-} |
363 | 362 | ||
364 | instance BEncode (FileInfo [ByteString]) where | 363 | instance BEncode (FileInfo [BS.ByteString]) where |
365 | toBEncode FileInfo {..} = toDict $ | 364 | toBEncode FileInfo {..} = toDict $ |
366 | "length" .=! fiLength | 365 | "length" .=! fiLength |
367 | .: "md5sum" .=? fiMD5Sum | 366 | .: "md5sum" .=? fiMD5Sum |
@@ -377,20 +376,20 @@ instance BEncode (FileInfo [ByteString]) where | |||
377 | 376 | ||
378 | type Put a = a -> BDict -> BDict | 377 | type Put a = a -> BDict -> BDict |
379 | 378 | ||
380 | putFileInfoSingle :: Data.Torrent.Put (FileInfo ByteString) | 379 | putFileInfoSingle :: Data.Torrent.Put (FileInfo BS.ByteString) |
381 | putFileInfoSingle FileInfo {..} cont = | 380 | putFileInfoSingle FileInfo {..} cont = |
382 | "length" .=! fiLength | 381 | "length" .=! fiLength |
383 | .: "md5sum" .=? fiMD5Sum | 382 | .: "md5sum" .=? fiMD5Sum |
384 | .: "name" .=! fiName | 383 | .: "name" .=! fiName |
385 | .: cont | 384 | .: cont |
386 | 385 | ||
387 | getFileInfoSingle :: BE.Get (FileInfo ByteString) | 386 | getFileInfoSingle :: BE.Get (FileInfo BS.ByteString) |
388 | getFileInfoSingle = do | 387 | getFileInfoSingle = do |
389 | FileInfo <$>! "length" | 388 | FileInfo <$>! "length" |
390 | <*>? "md5sum" | 389 | <*>? "md5sum" |
391 | <*>! "name" | 390 | <*>! "name" |
392 | 391 | ||
393 | instance BEncode (FileInfo ByteString) where | 392 | instance BEncode (FileInfo BS.ByteString) where |
394 | toBEncode = toDict . (`putFileInfoSingle` endDict) | 393 | toBEncode = toDict . (`putFileInfoSingle` endDict) |
395 | {-# INLINE toBEncode #-} | 394 | {-# INLINE toBEncode #-} |
396 | 395 | ||
@@ -406,7 +405,7 @@ instance Pretty (FileInfo BS.ByteString) where | |||
406 | ppMD5 md5 = "MD5 : " <> text (show (Base16.encode md5)) | 405 | ppMD5 md5 = "MD5 : " <> text (show (Base16.encode md5)) |
407 | 406 | ||
408 | -- | Join file path. | 407 | -- | Join file path. |
409 | joinFilePath :: FileInfo [ByteString] -> FileInfo ByteString | 408 | joinFilePath :: FileInfo [BS.ByteString] -> FileInfo BS.ByteString |
410 | joinFilePath = fmap (BS.intercalate "/") | 409 | joinFilePath = fmap (BS.intercalate "/") |
411 | 410 | ||
412 | {----------------------------------------------------------------------- | 411 | {----------------------------------------------------------------------- |
@@ -422,15 +421,15 @@ joinFilePath = fmap (BS.intercalate "/") | |||
422 | data LayoutInfo | 421 | data LayoutInfo |
423 | = SingleFile | 422 | = SingleFile |
424 | { -- | Single file info. | 423 | { -- | Single file info. |
425 | liFile :: !(FileInfo ByteString) | 424 | liFile :: !(FileInfo BS.ByteString) |
426 | } | 425 | } |
427 | | MultiFile | 426 | | MultiFile |
428 | { -- | List of the all files that torrent contains. | 427 | { -- | List of the all files that torrent contains. |
429 | liFiles :: ![FileInfo [ByteString]] | 428 | liFiles :: ![FileInfo [BS.ByteString]] |
430 | 429 | ||
431 | -- | The /suggested/ name of the root directory in which to | 430 | -- | The /suggested/ name of the root directory in which to |
432 | -- store all the files. | 431 | -- store all the files. |
433 | , liDirName :: !ByteString | 432 | , liDirName :: !BS.ByteString |
434 | } deriving (Show, Read, Eq, Typeable) | 433 | } deriving (Show, Read, Eq, Typeable) |
435 | 434 | ||
436 | makeLensesFor | 435 | makeLensesFor |
@@ -482,7 +481,7 @@ isMultiFile _ = False | |||
482 | {-# INLINE isMultiFile #-} | 481 | {-# INLINE isMultiFile #-} |
483 | 482 | ||
484 | -- | Get name of the torrent based on the root path piece. | 483 | -- | Get name of the torrent based on the root path piece. |
485 | suggestedName :: LayoutInfo -> ByteString | 484 | suggestedName :: LayoutInfo -> BS.ByteString |
486 | suggestedName (SingleFile FileInfo {..}) = fiName | 485 | suggestedName (SingleFile FileInfo {..}) = fiName |
487 | suggestedName MultiFile {..} = liDirName | 486 | suggestedName MultiFile {..} = liDirName |
488 | {-# INLINE suggestedName #-} | 487 | {-# INLINE suggestedName #-} |
@@ -520,9 +519,9 @@ flatLayout prefixPath SingleFile { liFile = FileInfo {..} } | |||
520 | = [(prefixPath </> BC.unpack fiName, fiLength)] | 519 | = [(prefixPath </> BC.unpack fiName, fiLength)] |
521 | flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles | 520 | flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles |
522 | where -- TODO use utf8 encoding in name | 521 | where -- TODO use utf8 encoding in name |
523 | mkPath FileInfo {..} = (path, fiLength) | 522 | mkPath FileInfo {..} = (_path, fiLength) |
524 | where | 523 | where |
525 | path = prefixPath </> BC.unpack liDirName | 524 | _path = prefixPath </> BC.unpack liDirName |
526 | </> joinPath (L.map BC.unpack fiName) | 525 | </> joinPath (L.map BC.unpack fiName) |
527 | 526 | ||
528 | -- | Calculate offset of each file based on its length, incrementally. | 527 | -- | Calculate offset of each file based on its length, incrementally. |
@@ -597,7 +596,7 @@ defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc | |||
597 | -- Piece data | 596 | -- Piece data |
598 | -----------------------------------------------------------------------} | 597 | -----------------------------------------------------------------------} |
599 | 598 | ||
600 | type PieceHash = ByteString | 599 | type PieceHash = BS.ByteString |
601 | 600 | ||
602 | hashsize :: Int | 601 | hashsize :: Int |
603 | hashsize = 20 | 602 | hashsize = 20 |
@@ -632,7 +631,7 @@ hashPiece Piece {..} = SHA1.hashlazy pieceData | |||
632 | -----------------------------------------------------------------------} | 631 | -----------------------------------------------------------------------} |
633 | 632 | ||
634 | -- | A flat array of SHA1 hash for each piece. | 633 | -- | A flat array of SHA1 hash for each piece. |
635 | newtype HashList = HashList { unHashList :: ByteString } | 634 | newtype HashList = HashList { unHashList :: BS.ByteString } |
636 | deriving (Show, Read, Eq, BEncode, Typeable) | 635 | deriving (Show, Read, Eq, BEncode, Typeable) |
637 | 636 | ||
638 | -- | Empty hash list. | 637 | -- | Empty hash list. |
@@ -688,7 +687,7 @@ instance BEncode PieceInfo where | |||
688 | instance Pretty PieceInfo where | 687 | instance Pretty PieceInfo where |
689 | pretty PieceInfo {..} = "Piece size: " <> int piPieceLength | 688 | pretty PieceInfo {..} = "Piece size: " <> int piPieceLength |
690 | 689 | ||
691 | slice :: Int -> Int -> ByteString -> ByteString | 690 | slice :: Int -> Int -> BS.ByteString -> BS.ByteString |
692 | slice start len = BS.take len . BS.drop start | 691 | slice start len = BS.take len . BS.drop start |
693 | {-# INLINE slice #-} | 692 | {-# INLINE slice #-} |
694 | 693 | ||
@@ -773,7 +772,7 @@ putPrivate True = \ cont -> "private" .=! True .: cont | |||
773 | 772 | ||
774 | -- | Hash lazy bytestring using SHA1 algorithm. | 773 | -- | Hash lazy bytestring using SHA1 algorithm. |
775 | hashLazyIH :: BL.ByteString -> InfoHash | 774 | hashLazyIH :: BL.ByteString -> InfoHash |
776 | hashLazyIH = either (const (error msg)) id . safeConvert . C.hashlazy | 775 | hashLazyIH = either (const (error msg)) id . safeConvert . SHA1.hashlazy |
777 | where | 776 | where |
778 | msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long" | 777 | msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long" |
779 | 778 | ||
@@ -850,7 +849,7 @@ data Torrent = Torrent | |||
850 | -- authority to allow new peers onto the swarm. | 849 | -- authority to allow new peers onto the swarm. |
851 | 850 | ||
852 | , tPublisherURL :: !(Maybe URI) | 851 | , tPublisherURL :: !(Maybe URI) |
853 | , tSignature :: !(Maybe ByteString) | 852 | , tSignature :: !(Maybe BS.ByteString) |
854 | -- ^ The RSA signature of the info dictionary (specifically, the | 853 | -- ^ The RSA signature of the info dictionary (specifically, the |
855 | -- encrypted SHA-1 hash of the info dictionary). | 854 | -- encrypted SHA-1 hash of the info dictionary). |
856 | } deriving (Show, Eq, Typeable) | 855 | } deriving (Show, Eq, Typeable) |
@@ -1049,15 +1048,15 @@ instance QueryValueLike URN where | |||
1049 | 1048 | ||
1050 | ----------------------------------------------------------------------- | 1049 | ----------------------------------------------------------------------- |
1051 | 1050 | ||
1052 | unsnoc :: [a] -> Maybe ([a], a) | 1051 | _unsnoc :: [a] -> Maybe ([a], a) |
1053 | unsnoc [] = Nothing | 1052 | _unsnoc [] = Nothing |
1054 | unsnoc xs = Just (L.init xs, L.last xs) | 1053 | _unsnoc xs = Just (L.init xs, L.last xs) |
1055 | 1054 | ||
1056 | instance Convertible Text URN where | 1055 | instance Convertible Text URN where |
1057 | safeConvert t = case T.split (== ':') t of | 1056 | safeConvert t = case T.split (== ':') t of |
1058 | uriScheme : body | 1057 | uriScheme : body |
1059 | | T.toLower uriScheme == "urn" -> | 1058 | | T.toLower uriScheme == "urn" -> |
1060 | case unsnoc body of | 1059 | case _unsnoc body of |
1061 | Just (namespace, val) -> pure URN | 1060 | Just (namespace, val) -> pure URN |
1062 | { urnNamespace = namespace | 1061 | { urnNamespace = namespace |
1063 | , urnString = val | 1062 | , urnString = val |