bittorrent (empty) → 0.0.0.1
raw patch · 15 files changed
+1702/−0 lines, 15 filesdep +BoundedChandep +HTTPdep +IntervalMapsetup-changedbinary-added
Dependencies added: BoundedChan, HTTP, IntervalMap, QuickCheck, SafeSemaphore, aeson, base, base16-bytestring, base32-bytestring, base64-bytestring, bencoding, binary, binary-conduit, bits-extras, bittorrent, bytestring, cereal, cereal-conduit, conduit, containers, cryptohash, data-default, deepseq, directory, entropy, filepath, hashable, hspec, intset, krpc, lens, mmap, mtl, network, network-conduit, old-locale, pretty, quickcheck-instances, resourcet, stm, text, time, transformers, unordered-containers, urlencoded, vector
Files
- LICENSE +30/−0
- README.md +36/−0
- Setup.hs +2/−0
- bittorrent.cabal +174/−0
- changelog +1/−0
- res/dapper-dvd-amd64.iso.torrent binary
- res/pkg.torrent binary
- src/Data/Torrent.hs +289/−0
- src/Data/Torrent/Block.hs +198/−0
- src/Data/Torrent/InfoHash.hs +149/−0
- src/Data/Torrent/Layout.hs +292/−0
- src/Data/Torrent/Magnet.hs +223/−0
- src/Data/Torrent/Piece.hs +226/−0
- src/Data/Torrent/Tree.hs +81/−0
- tests/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Sam Truzjan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sam Truzjan nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,36 @@+### Synopsis++A library for making Haskell applications which use bittorrent+protocol easy. This package aims to be a fast thin layer and at the+same time provide both:++* Concise high level API for typical usage scenarious.+* More straightforward API if you need more fine grained control.++Currently it provides serialization and deserealization of core+datatypes, some widely used routines and core types.++### Status++See list of implemented [BEPs](BEP.md).++### Documentation++For documentation see haddock generated documentation.++### Build Status++[![Build Status][1]][2]++[1]: https://travis-ci.org/cobit/bittorrent.png+[2]: https://travis-ci.org/cobit/bittorrent+++### Maintainer++This library is written and maintained by Sam T. <pxqr.sta@gmail.com>++Feel free to report bugs and suggestions via+[github issue tracker][issues] or the mail.++[issues]: https://github.com/cobit/bittorrent/issues/new
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bittorrent.cabal view
@@ -0,0 +1,174 @@+name: bittorrent+version: 0.0.0.1+license: BSD3+license-file: LICENSE+author: Sam Truzjan+maintainer: Sam Truzjan <pxqr.sta@gmail.com>+copyright: (c) 2013, Sam Truzjan+category: Network+build-type: Simple+cabal-version: >= 1.10+tested-with: GHC == 7.4.1+ , GHC == 7.6.3+homepage: https://github.com/cobit/bittorrent+bug-reports: https://github.com/cobit/bittorrent/issues+synopsis: Bittorrent protocol implementation.+description:++ A library for making Haskell bittorrent applications easy.+ .+ For more information see:+ <https://github.com/cobit/bittorrent/blob/master/README.md>++extra-source-files: res/dapper-dvd-amd64.iso.torrent+ res/pkg.torrent+ , README.md+ , changelog++source-repository head+ type: git+ location: git://github.com/cobit/bittorrent.git++source-repository this+ type: git+ location: git://github.com/cobit/bittorrent.git+ branch: master+ tag: v0.0.0.1++library+ default-language: Haskell2010+ default-extensions: PatternGuards+ , OverloadedStrings+ , RecordWildCards+ hs-source-dirs: src+ exposed-modules: Data.Torrent+-- , Data.Torrent.Bitfield+ , Data.Torrent.Block+ , Data.Torrent.InfoHash+ , Data.Torrent.Layout+ , Data.Torrent.Magnet+ , Data.Torrent.Piece+ , Data.Torrent.Tree++-- , System.IO.MMap.Fixed+-- , System.Torrent.Storage++-- Network.BitTorrent+-- , Network.BitTorrent.Extension+-- , Network.BitTorrent.Peer+-- , Network.BitTorrent.Tracker+-- , Network.BitTorrent.Tracker.Protocol+-- , Network.BitTorrent.Tracker.HTTP+-- , Network.BitTorrent.Tracker.UDP+-- , Network.BitTorrent.Exchange+-- , Network.BitTorrent.Exchange.Protocol+-- , Network.BitTorrent.DHT+-- , Network.BitTorrent.DHT.Protocol+-- , Network.BitTorrent.Sessions+-- other-modules: Network.BitTorrent.Sessions.Types+ build-depends: base == 4.*+ , bits-extras+ , pretty++ -- Control+ , deepseq+ , lens+ , mtl+ , resourcet+ , transformers++ -- Concurrency+ , SafeSemaphore+ , BoundedChan >= 1.0.1.0+ , stm >= 2.4++ -- Streaming+ , conduit >= 1.0+ , network-conduit >= 1.0+ , cereal-conduit >= 0.5+ , binary-conduit++ -- Data & Data structures+ , bytestring >= 0.10.0.0+ , containers >= 0.4+ , data-default+ , IntervalMap+ , intset+ , text >= 0.11.0+ , unordered-containers+ , vector++ -- Hashing+ , cryptohash+ , hashable++ -- Codecs & Serialization+ , aeson+ , base16-bytestring+ , base32-bytestring+ , base64-bytestring+ , bencoding >= 0.4+ , binary+ , cereal >= 0.3+ , urlencoded >= 0.4++ -- Time+ , old-locale >= 1.0+ , time >= 0.1++ -- Network+ , network >= 2.4+ , HTTP >= 4000.2+ , krpc >= 0.3++ -- System+ , directory >= 1+ , entropy+ , filepath >= 1+ , mmap++ ghc-options: -Wall+ ghc-prof-options:+++test-suite spec+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Spec.hs+ build-depends: base == 4.*+ , bytestring+ , directory+ , filepath++ , aeson+ , cereal+ , network+ , text++ , hspec+ , QuickCheck+ , quickcheck-instances++ , bencoding+ , bittorrent+ ghc-options: -Wall -fno-warn-orphans+++--benchmark bench+-- default-language: Haskell2010+-- default-extensions:+-- type: exitcode-stdio-1.0+-- hs-source-dirs: bench+-- main-is: Main.hs+-- build-depends: base+-- , bytestring+-- , cereal+-- , network+--+-- , criterion+-- , deepseq+--+-- , bittorrent+-- ghc-options: -O2 -Wall -fno-warn-orphans
+ changelog view
@@ -0,0 +1,1 @@+* 0.0.0.1: Initial version.
+ res/dapper-dvd-amd64.iso.torrent view
binary file changed (absent → 64198 bytes)
+ res/pkg.torrent view
binary file changed (absent → 32113 bytes)
+ src/Data/Torrent.hs view
@@ -0,0 +1,289 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Torrent file contains metadata about files and folders but not+-- content itself. The files are bencoded dictionaries. There is+-- also other info which is used to help join the swarm.+--+-- This module provides torrent metainfo serialization and info hash+-- extraction.+--+-- For more info see:+-- <http://www.bittorrent.org/beps/bep_0003.html#metainfo-files>,+-- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure>+--+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fno-warn-orphans #-}+module Data.Torrent+ ( -- * Info dictionary+ InfoDict (..)++ -- ** Lenses+ , infohash+ , layoutInfo+ , pieceInfo+ , isPrivate++ -- * Torrent file+ , Torrent(..)++ -- ** Lenses+ , announce+ , announceList+ , comment+ , createdBy+ , creationDate+ , encoding+ , infoDict+ , publisher+ , publisherURL+ , signature++ -- * Construction+ , nullTorrent++ -- * File paths+ , torrentExt+ , isTorrentPath++ -- * IO+ , fromFile+ , toFile+ ) where++import Prelude hiding (sum)++import Control.Applicative+import Control.DeepSeq+import Control.Exception+import Control.Lens++import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..), withText)+import Data.Aeson.TH+import Data.BEncode as BE+import Data.BEncode.Types as BE+import Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC (pack, unpack)+import qualified Data.ByteString.Lazy as BL+import Data.Char as Char+import Data.Hashable as Hashable+import qualified Data.List as L+import Data.Text as T+import Data.Time+import Data.Time.Clock.POSIX+import Data.Typeable+import Network.URI+import System.FilePath++import Data.Torrent.InfoHash as IH+import Data.Torrent.Layout+import Data.Torrent.Piece+++{-----------------------------------------------------------------------+-- Info dictionary+-----------------------------------------------------------------------}++{- note that info hash is actually reduntant field+ but it's better to keep it here to avoid heavy recomputations+-}++-- | Info part of the .torrent file contain info about each content file.+data InfoDict = InfoDict+ { idInfoHash :: !InfoHash+ -- ^ SHA1 hash of the (other) 'DictInfo' fields.+ , idLayoutInfo :: !LayoutInfo+ , idPieceInfo :: !PieceInfo+ , idPrivate :: !Bool+ -- ^ If set the client MUST publish its presence to get other+ -- peers ONLY via the trackers explicity described in the+ -- metainfo file.+ --+ -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html>+ } deriving (Show, Read, Eq, Typeable)++$(deriveJSON (L.map Char.toLower . L.dropWhile isLower) ''InfoDict)++makeLensesFor+ [ ("idInfoHash" , "infohash" )+ , ("idLayoutInfo", "layoutInfo")+ , ("idPieceInfo" , "pieceInfo" )+ , ("idPrivate" , "isPrivate" )+ ]+ ''InfoDict++instance NFData InfoDict where+ rnf InfoDict {..} = rnf idLayoutInfo++instance Hashable InfoDict where+ hash = Hashable.hash . idInfoHash+ {-# INLINE hash #-}++getPrivate :: Get Bool+getPrivate = (Just True ==) <$>? "private"++putPrivate :: Bool -> BDict -> BDict+putPrivate False = id+putPrivate True = \ cont -> "private" .=! True .: cont++instance BEncode InfoDict where+ toBEncode InfoDict {..} = toDict $+ putLayoutInfo idLayoutInfo $+ putPieceInfo idPieceInfo $+ putPrivate idPrivate $+ endDict++ fromBEncode dict = (`fromDict` dict) $ do+ InfoDict ih <$> getLayoutInfo+ <*> getPieceInfo+ <*> getPrivate+ where+ ih = IH.hashlazy (encode dict)++{-----------------------------------------------------------------------+-- Torrent info+-----------------------------------------------------------------------}++-- | Metainfo about particular torrent.+data Torrent = Torrent+ { tAnnounce :: !URI+ -- ^ The URL of the tracker.++ , tAnnounceList :: !(Maybe [[URI]])+ -- ^ Announce list add multiple tracker support.+ --+ -- BEP 12: <http://www.bittorrent.org/beps/bep_0012.html>++ , tComment :: !(Maybe Text)+ -- ^ Free-form comments of the author.++ , tCreatedBy :: !(Maybe Text)+ -- ^ Name and version of the program used to create the .torrent.++ , tCreationDate :: !(Maybe POSIXTime)+ -- ^ Creation time of the torrent, in standard UNIX epoch.++ , tEncoding :: !(Maybe Text)+ -- ^ String encoding format used to generate the pieces part of+ -- the info dictionary in the .torrent metafile.++ , tInfoDict :: !InfoDict+ -- ^ Info about each content file.++ , tPublisher :: !(Maybe URI)+ -- ^ Containing the RSA public key of the publisher of the+ -- torrent. Private counterpart of this key that has the+ -- authority to allow new peers onto the swarm.++ , tPublisherURL :: !(Maybe URI)+ , tSignature :: !(Maybe ByteString)+ -- ^ The RSA signature of the info dictionary (specifically, the+ -- encrypted SHA-1 hash of the info dictionary).+ } deriving (Show, Eq, Typeable)++instance FromJSON URI where+ parseJSON = withText "URI" $+ maybe (fail "could not parse URI") pure . parseURI . T.unpack++instance ToJSON URI where+ toJSON = String . T.pack . show++instance ToJSON NominalDiffTime where+ toJSON = toJSON . posixSecondsToUTCTime++instance FromJSON NominalDiffTime where+ parseJSON v = utcTimeToPOSIXSeconds <$> parseJSON v++$(deriveJSON (L.map Char.toLower . L.dropWhile isLower) ''Torrent)++makeLensesFor+ [ ("tAnnounce" , "announce" )+ , ("tAnnounceList", "announceList")+ , ("tComment" , "comment" )+ , ("tCreatedBy" , "createdBy" )+ , ("tCreationDate", "creationDate")+ , ("tEncoding" , "encoding" )+ , ("tInfoDict" , "infoDict" )+ , ("tPublisher" , "publisher" )+ , ("tPublisherURL", "publisherURL")+ , ("tSignature" , "signature" )+ ]+ ''Torrent++instance NFData Torrent where+ rnf Torrent {..} = rnf tInfoDict++-- TODO move to bencoding+instance BEncode URI where+ toBEncode uri = toBEncode (BC.pack (uriToString id uri ""))+ {-# INLINE toBEncode #-}++ fromBEncode (BString s) | Just url <- parseURI (BC.unpack s) = return url+ fromBEncode b = decodingError $ "url <" ++ show b ++ ">"+ {-# INLINE fromBEncode #-}++-- TODO move to bencoding+instance BEncode POSIXTime where+ toBEncode pt = toBEncode (floor pt :: Integer)+ fromBEncode (BInteger i) = return $ fromIntegral i+ fromBEncode _ = decodingError $ "POSIXTime"++instance BEncode Torrent where+ toBEncode Torrent {..} = toDict $+ "announce" .=! tAnnounce+ .: "announce-list" .=? tAnnounceList+ .: "comment" .=? tComment+ .: "created by" .=? tCreatedBy+ .: "creation date" .=? tCreationDate+ .: "encoding" .=? tEncoding+ .: "info" .=! tInfoDict+ .: "publisher" .=? tPublisher+ .: "publisher-url" .=? tPublisherURL+ .: "signature" .=? tSignature+ .: endDict++ fromBEncode = fromDict $ do+ Torrent <$>! "announce"+ <*>? "announce-list"+ <*>? "comment"+ <*>? "created by"+ <*>? "creation date"+ <*>? "encoding"+ <*>! "info"+ <*>? "publisher"+ <*>? "publisher-url"+ <*>? "signature"++-- | A simple torrent contains only required fields.+nullTorrent :: URI -> InfoDict -> Torrent+nullTorrent ann info = Torrent+ ann Nothing Nothing Nothing Nothing Nothing+ info Nothing Nothing Nothing++-- | Extension usually used for torrent metafiles.+torrentExt :: String+torrentExt = "torrent"++-- | Test if this path has proper extension.+isTorrentPath :: FilePath -> Bool+isTorrentPath filepath = takeExtension filepath == extSeparator : torrentExt++-- | Read and decode a .torrent file.+fromFile :: FilePath -> IO Torrent+fromFile filepath = do+ contents <- BS.readFile filepath+ case decode contents of+ Right !t -> return t+ Left msg -> throwIO $ userError $ msg ++ " while reading torrent file"++toFile :: FilePath -> Torrent -> IO ()+toFile filepath = BL.writeFile filepath . encode
+ src/Data/Torrent/Block.hs view
@@ -0,0 +1,198 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Blocks are used to transfer pieces.+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+module Data.Torrent.Block+ ( -- * Piece attributes+ PieceIx+ , PieceSize++ -- * Block attributes+ , BlockOffset+ , BlockCount+ , BlockSize+ , defaultTransferSize++ -- * Block index+ , BlockIx(..)+ , ppBlockIx+ , blockIxRange++ -- * Block data+ , Block(..)+ , ppBlock+ , blockIx+ , blockSize+ , blockRange+ ) where++import Control.Applicative++import Data.Aeson.TH+import qualified Data.ByteString.Lazy as Lazy+import Data.Char+import Data.List as L++import Data.Binary as B+import Data.Binary.Get as B+import Data.Binary.Put as B+import Data.Serialize as S++import Text.PrettyPrint+++{-----------------------------------------------------------------------+-- Piece attributes+-----------------------------------------------------------------------}++-- | Zero-based index of piece in torrent content.+type PieceIx = Int++-- | Size of piece in bytes. Should be a power of 2.+--+-- NOTE: Have max and min size constrained to wide used+-- semi-standard values. This bounds should be used to make decision+-- about piece size for new torrents.+--+type PieceSize = Int++{-----------------------------------------------------------------------+-- Block attributes+-----------------------------------------------------------------------}++-- | Offset of a block in a piece in bytes. Should be multiple of+-- the choosen block size.+type BlockOffset = Int++-- | Size of a block in bytes. Should be power of 2.+--+-- Normally block size is equal to 'defaultTransferSize'.+--+type BlockSize = Int++-- | Number of block in a piece of a torrent. Used to distinguish+-- block count from piece count.+type BlockCount = Int++-- | Widely used semi-official block size. Some clients can ignore if+-- block size of BlockIx in Request message is not equal to this+-- value.+--+defaultTransferSize :: BlockSize+defaultTransferSize = 16 * 1024++{-----------------------------------------------------------------------+ Block Index+-----------------------------------------------------------------------}++-- | BlockIx correspond.+data BlockIx = BlockIx {+ -- | Zero-based piece index.+ ixPiece :: {-# UNPACK #-} !PieceIx++ -- | Zero-based byte offset within the piece.+ , ixOffset :: {-# UNPACK #-} !BlockOffset++ -- | Block size starting from offset.+ , ixLength :: {-# UNPACK #-} !BlockSize+ } deriving (Show, Eq)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx)++getInt :: S.Get Int+getInt = fromIntegral <$> S.getWord32be+{-# INLINE getInt #-}++putInt :: S.Putter Int+putInt = S.putWord32be . fromIntegral+{-# INLINE putInt #-}++getIntB :: B.Get Int+getIntB = fromIntegral <$> B.getWord32be+{-# INLINE getIntB #-}++putIntB :: Int -> B.Put+putIntB = B.putWord32be . fromIntegral+{-# INLINE putIntB #-}++instance Serialize BlockIx where+ {-# SPECIALIZE instance Serialize BlockIx #-}+ get = BlockIx <$> getInt+ <*> getInt+ <*> getInt+ {-# INLINE get #-}++ put BlockIx {..} = do+ putInt ixPiece+ putInt ixOffset+ putInt ixLength+ {-# INLINE put #-}++instance Binary BlockIx where+ {-# SPECIALIZE instance Binary BlockIx #-}+ get = BlockIx <$> getIntB+ <*> getIntB+ <*> getIntB+ {-# INLINE get #-}++ put BlockIx {..} = do+ putIntB ixPiece+ putIntB ixOffset+ putIntB ixLength++-- | Format block index in human readable form.+ppBlockIx :: BlockIx -> Doc+ppBlockIx BlockIx {..} =+ "piece = " <> int ixPiece <> "," <+>+ "offset = " <> int ixOffset <> "," <+>+ "length = " <> int ixLength++-- | Get location of payload bytes in the torrent content.+blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a)+blockIxRange pieceSize BlockIx {..} = (offset, offset + len)+ where+ offset = fromIntegral pieceSize * fromIntegral ixPiece+ + fromIntegral ixOffset+ len = fromIntegral ixLength+{-# INLINE blockIxRange #-}++{-----------------------------------------------------------------------+ Block+-----------------------------------------------------------------------}++data Block payload = Block {+ -- | Zero-based piece index.+ blkPiece :: {-# UNPACK #-} !PieceIx++ -- | Zero-based byte offset within the piece.+ , blkOffset :: {-# UNPACK #-} !BlockOffset++ -- | Payload bytes.+ , blkData :: !payload+ } deriving (Show, Eq)++-- | Format block in human readable form. Payload is ommitted.+ppBlock :: Block Lazy.ByteString -> Doc+ppBlock = ppBlockIx . blockIx+{-# INLINE ppBlock #-}++-- | Get size of block /payload/ in bytes.+blockSize :: Block Lazy.ByteString -> BlockSize+blockSize blk = fromIntegral (Lazy.length (blkData blk))+{-# INLINE blockSize #-}++-- | Get block index of a block.+blockIx :: Block Lazy.ByteString -> BlockIx+blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize++-- | Get location of payload bytes in the torrent content.+blockRange :: (Num a, Integral a) => PieceSize -> Block Lazy.ByteString -> (a, a)+blockRange pieceSize = blockIxRange pieceSize . blockIx+{-# INLINE blockRange #-}
+ src/Data/Torrent/InfoHash.hs view
@@ -0,0 +1,149 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Infohash is a unique identifier of torrent.+--+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.Torrent.InfoHash+ ( -- * Info hash+ InfoHash(..)+ , textToInfoHash+ , addHashToURI+ , ppInfoHash++ , Data.Torrent.InfoHash.hash+ , Data.Torrent.InfoHash.hashlazy+ ) where++import Control.Applicative+import Control.Monad+import qualified Crypto.Hash.SHA1 as C+import Data.Aeson+import Data.BEncode+import Data.ByteString as BS+import Data.ByteString.Char8 as BC+import Data.ByteString.Lazy as BL+import Data.ByteString.Base16 as Base16+import Data.ByteString.Base32 as Base32+import qualified Data.ByteString.Lazy.Builder as B+import qualified Data.ByteString.Lazy.Builder.ASCII as B+import Data.Char+import Data.List as L+import Data.Hashable as Hashable+import Data.URLEncoded as URL+import Data.Serialize+import Data.String+import Data.Text+import Data.Text.Encoding as T+import Network.URI+import Numeric+import Text.ParserCombinators.ReadP as P+import Text.PrettyPrint+++-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.+newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }+ deriving (Eq, Ord)++-- | for hex encoded strings+instance Show InfoHash where+ show = render . ppInfoHash++-- | for hex encoded strings+instance Read InfoHash where+ readsPrec _ = readP_to_S $ do+ str <- replicateM 40 (satisfy isHexDigit)+ return $ InfoHash $ decodeIH str+ where+ decodeIH = BS.pack . L.map fromHex . pair+ fromHex (a, b) = read $ '0' : 'x' : a : b : []++ pair (a : b : xs) = (a, b) : pair xs+ pair _ = []++-- | for base16 (hex) encoded strings+instance IsString InfoHash where+ fromString str+ | L.length str == 40+ , (ihStr, inv) <- Base16.decode $ BC.pack str+ = if BS.length inv == 0 then InfoHash ihStr+ else error "fromString: invalid infohash string"+ | otherwise = error "fromString: invalid infohash string length"++instance Hashable InfoHash where+ hash = Hashable.hash . getInfoHash++instance BEncode InfoHash where+ toBEncode = toBEncode . getInfoHash+ fromBEncode be = InfoHash <$> fromBEncode be++instance Serialize InfoHash where+ put = putByteString . getInfoHash+ get = InfoHash <$> getBytes 20++-- | Represented as base16 encoded string.+instance ToJSON InfoHash where+ toJSON (InfoHash ih) = String $ T.decodeUtf8 $ Base16.encode ih++-- | Can be base16 or base32 encoded string.+instance FromJSON InfoHash where+ parseJSON = withText "JSON" $+ maybe (fail "could not parse InfoHash") pure . textToInfoHash++instance URLShow InfoHash where+ urlShow = show++-- | Tries both base16 and base32 while decoding info hash.+textToInfoHash :: Text -> Maybe InfoHash+textToInfoHash text+ | hashLen == 32 = Just $ InfoHash $ Base32.decode hashStr+ | hashLen == 40 = let (ihStr, inv) = Base16.decode hashStr+ in if BS.length inv == 0+ then Just $ InfoHash ihStr+ else Nothing+ | otherwise = Nothing+ where+ hashLen = BS.length hashStr+ hashStr = T.encodeUtf8 text++-- | Hash strict bytestring using SHA1 algorithm.+hash :: BS.ByteString -> InfoHash+hash = InfoHash . C.hash++-- | Hash lazy bytestring using SHA1 algorithm.+hashlazy :: BL.ByteString -> InfoHash+hashlazy = InfoHash . C.hashlazy++-- | Pretty print info hash in hexadecimal format.+ppInfoHash :: InfoHash -> Doc+ppInfoHash = text . BC.unpack . ppHex . getInfoHash++ppHex :: BS.ByteString -> BS.ByteString+ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed++-- | Add query info hash parameter to uri.+--+-- > info_hash=<url_encoded_info_hash>+--+addHashToURI :: URI -> InfoHash -> URI+addHashToURI uri s = uri {+ uriQuery = uriQuery uri ++ mkPref (uriQuery uri) +++ "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s))+ }+ where+ mkPref [] = "?"+ mkPref ('?' : _) = "&"+ mkPref _ = error "addHashToURI"++ rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c)+ where+ unreservedS = (`L.elem` chars)+ chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./"+ encodeHex c = '%' : pHex c+ pHex c = let p = (showHex . ord $ c) ""+ in if L.length p == 1 then '0' : p else p
+ src/Data/Torrent/Layout.hs view
@@ -0,0 +1,292 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Layout of files in torrent.+--+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fno-warn-orphans #-}+module Data.Torrent.Layout+ ( -- * File attributes+ FileOffset+ , FileSize++ -- * Single file info+ , FileInfo (..)++ -- ** Lens+ , fileLength+ , filePath+ , fileMD5Sum++ -- * File layout+ , LayoutInfo (..)++ -- ** Lens+ , singleFile+ , multiFile+ , rootDirName++ -- ** Predicates+ , isSingleFile+ , isMultiFile++ -- ** Folds+ , contentLength+ , fileCount+ , blockCount++ -- * Flat file layout+ , Layout+ , flatLayout+ , accumOffsets+ , fileOffset++ -- * Internal+ , getLayoutInfo+ , putLayoutInfo+ ) where++import Control.Applicative+import Control.DeepSeq+import Control.Lens+import Data.Aeson.TH+import Data.Aeson.Types (FromJSON, ToJSON)+import Data.BEncode+import Data.BEncode.Types+import Data.ByteString as BS+import Data.ByteString.Char8 as BC+import Data.Char+import Data.List as L+import Data.Typeable+import System.FilePath+import System.Posix.Types++import Data.Torrent.Block+++{-----------------------------------------------------------------------+-- File attribytes+-----------------------------------------------------------------------}++-- | Size of a file in bytes.+type FileSize = FileOffset++deriving instance FromJSON FileOffset+deriving instance ToJSON FileOffset+deriving instance BEncode FileOffset++{-----------------------------------------------------------------------+-- File info both either from info dict or file list+-----------------------------------------------------------------------}++-- | Contain metainfo about one single file.+data FileInfo a = FileInfo {+ fiLength :: {-# UNPACK #-} !FileSize+ -- ^ Length of the file in bytes.++ -- TODO unpacked MD5 sum+ , fiMD5Sum :: !(Maybe ByteString)+ -- ^ 32 character long MD5 sum of the file. Used by third-party+ -- tools, not by bittorrent protocol itself.++ , fiName :: !a+ -- ^ One or more string elements that together represent the+ -- path and filename. Each element in the list corresponds to+ -- either a directory name or (in the case of the last element)+ -- the filename. For example, the file:+ --+ -- > "dir1/dir2/file.ext"+ --+ -- would consist of three string elements:+ --+ -- > ["dir1", "dir2", "file.ext"]+ --+ } deriving (Show, Read, Eq, Typeable)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)++makeLensesFor+ [ ("fiLength", "fileLength")+ , ("fiMD5Sum", "fileMD5Sum")+ , ("fiName" , "filePath" )+ ]+ ''FileInfo++instance NFData a => NFData (FileInfo a) where+ rnf FileInfo {..} = rnf fiName+ {-# INLINE rnf #-}++instance BEncode (FileInfo [ByteString]) where+ toBEncode FileInfo {..} = toDict $+ "length" .=! fiLength+ .: "md5sum" .=? fiMD5Sum+ .: "path" .=! fiName+ .: endDict+ {-# INLINE toBEncode #-}++ fromBEncode = fromDict $ do+ FileInfo <$>! "length"+ <*>? "md5sum"+ <*>! "path"+ {-# INLINE fromBEncode #-}++type Put a = a -> BDict -> BDict++putFileInfoSingle :: Put (FileInfo ByteString)+putFileInfoSingle FileInfo {..} cont =+ "length" .=! fiLength+ .: "md5sum" .=? fiMD5Sum+ .: "name" .=! fiName+ .: cont++getFileInfoSingle :: Get (FileInfo ByteString)+getFileInfoSingle = do+ FileInfo <$>! "length"+ <*>? "md5sum"+ <*>! "name"++instance BEncode (FileInfo ByteString) where+ toBEncode = toDict . (`putFileInfoSingle` endDict)+ {-# INLINE toBEncode #-}++ fromBEncode = fromDict getFileInfoSingle+ {-# INLINE fromBEncode #-}++{-----------------------------------------------------------------------+-- Original torrent file layout info+-----------------------------------------------------------------------}++-- | Original (found in torrent file) layout info is either:+--+-- * Single file with its /name/.+--+-- * Multiple files with its relative file /paths/.+--+data LayoutInfo+ = SingleFile+ { -- | Single file info.+ liFile :: !(FileInfo ByteString)+ }+ | MultiFile+ { -- | List of the all files that torrent contains.+ liFiles :: ![FileInfo [ByteString]]++ -- | The /suggested/ name of the root directory in which to+ -- store all the files.+ , liDirName :: !ByteString+ } deriving (Show, Read, Eq, Typeable)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''LayoutInfo)++makeLensesFor+ [ ("liFile" , "singleFile" )+ , ("liFiles" , "multiFile" )+ , ("liDirName", "rootDirName")+ ]+ ''LayoutInfo++instance NFData LayoutInfo where+ rnf SingleFile {..} = ()+ rnf MultiFile {..} = rnf liFiles++getLayoutInfo :: Get LayoutInfo+getLayoutInfo = single <|> multi+ where+ single = SingleFile <$> getFileInfoSingle+ multi = MultiFile <$>! "files" <*>! "name"++putLayoutInfo :: Put LayoutInfo+putLayoutInfo SingleFile {..} = putFileInfoSingle liFile+putLayoutInfo MultiFile {..} = \ cont ->+ "files" .=! liFiles+ .: "name" .=! liDirName+ .: cont++instance BEncode LayoutInfo where+ toBEncode = toDict . (`putLayoutInfo` endDict)+ fromBEncode = fromDict getLayoutInfo++-- | Test if this is single file torrent.+isSingleFile :: LayoutInfo -> Bool+isSingleFile SingleFile {} = True+isSingleFile _ = False+{-# INLINE isSingleFile #-}++-- | Test if this is multifile torrent.+isMultiFile :: LayoutInfo -> Bool+isMultiFile MultiFile {} = True+isMultiFile _ = False+{-# INLINE isMultiFile #-}++-- | Find sum of sizes of the all torrent files.+contentLength :: LayoutInfo -> FileSize+contentLength SingleFile { liFile = FileInfo {..} } = fiLength+contentLength MultiFile { liFiles = tfs } = sum (L.map fiLength tfs)++-- | Get number of all files in torrent.+fileCount :: LayoutInfo -> Int+fileCount SingleFile {..} = 1+fileCount MultiFile {..} = L.length liFiles++-- | Find number of blocks of the specified size. If torrent size is+-- not a multiple of block size then the count is rounded up.+blockCount :: BlockSize -> LayoutInfo -> Int+blockCount blkSize ci = contentLength ci `sizeInBase` blkSize++{-----------------------------------------------------------------------+-- Flat layout+-----------------------------------------------------------------------}++-- | File layout specifies the order and the size of each file in the+-- storage. Note that order of files is highly important since we+-- coalesce all the files in the given order to get the linear block+-- address space.+--+type Layout a = [(FilePath, a)]++-- | Extract files layout from torrent info with the given root path.+flatLayout+ :: FilePath -- ^ Root path for the all torrent files.+ -> LayoutInfo -- ^ Torrent content information.+ -> Layout FileSize -- ^ The all file paths prefixed with the given root.+flatLayout prefixPath SingleFile { liFile = FileInfo {..} }+ = [(prefixPath </> BC.unpack fiName, fiLength)]+flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles+ where -- TODO use utf8 encoding in name+ mkPath FileInfo {..} = (path, fiLength)+ where+ path = prefixPath </> BC.unpack liDirName+ </> joinPath (L.map BC.unpack fiName)++-- | Calculate offset of each file based on its length, incrementally.+accumOffsets :: Layout FileSize -> Layout FileOffset+accumOffsets = go 0+ where+ go !_ [] = []+ go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs++-- | Gives global offset of a content file for a given full path.+fileOffset :: FilePath -> Layout FileOffset -> Maybe FileOffset+fileOffset = lookup+{-# INLINE fileOffset #-}++{-----------------------------------------------------------------------+-- Internal utilities+-----------------------------------------------------------------------}++-- | Divide and round up.+sizeInBase :: Integral a => a -> Int -> Int+sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align+ where+ align = if n `mod` fromIntegral b == 0 then 0 else 1+{-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}+{-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
+ src/Data/Torrent/Magnet.hs view
@@ -0,0 +1,223 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Parsing and rendering of magnet URIs.+--+-- For more info see:+-- <http://magnet-uri.sourceforge.net/magnet-draft-overview.txt>+--+-- Bittorrent specific info:+-- <http://www.bittorrent.org/beps/bep_0009.html>+--+module Data.Torrent.Magnet+ ( -- * Magnet+ Magnet(..)+ , nullMagnet+ , parseMagnet+ , renderMagnet++ -- ** Extra+ , fromURI+ , toURI+ ) where++import Control.Applicative+import Control.Monad+import Data.Map as M+import Data.Maybe+import Data.List as L+import Data.URLEncoded as URL+import Data.String+import Data.Text as T+import Network.URI+import Text.Read++import Data.Torrent.InfoHash+++{-----------------------------------------------------------------------+-- URN+-----------------------------------------------------------------------}++type NamespaceId = [Text]++btih :: NamespaceId+btih = ["btih"]++-- | Uniform Resource Name - location-independent, resource+-- identifier.+data URN = URN+ { urnNamespace :: NamespaceId+ , urnString :: Text+ } deriving (Eq, Ord)++instance Show URN where+ showsPrec n = showsPrec n . T.unpack . renderURN++instance IsString URN where+ fromString = fromMaybe def . parseURN . T.pack+ where+ def = error "unable to parse URN"++instance URLShow URN where+ urlShow = T.unpack . renderURN++parseURN :: Text -> Maybe URN+parseURN str = case T.split (== ':') str of+ uriScheme : body+ | T.toLower uriScheme == "urn" -> mkURN body+ | otherwise -> Nothing+ [] -> Nothing+ where+ mkURN [] = Nothing+ mkURN xs = Just $ URN+ { urnNamespace = L.init xs+ , urnString = L.last xs+ }++renderURN :: URN -> Text+renderURN URN {..}+ = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]++urnToInfoHash :: URN -> Maybe InfoHash+urnToInfoHash (URN {..})+ | urnNamespace /= btih = Nothing+ | otherwise = textToInfoHash urnString++infoHashToURN :: InfoHash -> URN+infoHashToURN = URN btih . T.pack . show++{-----------------------------------------------------------------------+-- Magnet+-----------------------------------------------------------------------}++-- TODO multiple exact topics+-- TODO supplement++-- | An URI used to identify torrent.+data Magnet = Magnet+ { -- | Resource hash.+ exactTopic :: !InfoHash+ -- | Might be used to display name while waiting for metadata.+ , displayName :: Maybe Text+ -- | Size of the resource in bytes.+ , exactLength :: Maybe Integer++ , manifest :: Maybe String+ -- | Search string.+ , keywordTopic :: Maybe String++ , acceptableSource :: Maybe URI+ , exactSource :: Maybe URI++ , tracker :: Maybe URI++ , supplement :: Map Text Text+ } deriving (Eq, Ord)++instance Show Magnet where+ show = renderMagnet+ {-# INLINE show #-}++instance Read Magnet where+ readsPrec _ xs+ | Just m <- parseMagnet mstr = [(m, rest)]+ | otherwise = []+ where+ (mstr, rest) = L.break (== ' ') xs++instance IsString Magnet where+ fromString = fromMaybe def . parseMagnet+ where+ def = error "unable to parse magnet"++instance URLEncode Magnet where+ urlEncode = toQuery+ {-# INLINE urlEncode #-}++-- | Set exact topic only, other params are empty.+nullMagnet :: InfoHash -> Magnet+nullMagnet u = Magnet+ { exactTopic = u+ , displayName = Nothing+ , exactLength = Nothing+ , manifest = Nothing+ , keywordTopic = Nothing+ , acceptableSource = Nothing+ , exactSource = Nothing+ , tracker = Nothing+ , supplement = M.empty+ }++fromQuery :: URLEncoded -> Either String Magnet+fromQuery q+ | Just urnStr <- URL.lookup ("xt" :: String) q+ , Just urn <- parseURN $ T.pack urnStr+ , Just infoHash <- urnToInfoHash urn+ = return $ Magnet+ { exactTopic = infoHash+ , displayName = T.pack <$> URL.lookup ("dn" :: String) q+ , exactLength = readMaybe =<< URL.lookup ("xl" :: String) q++ , manifest = URL.lookup ("mt" :: String) q+ , keywordTopic = URL.lookup ("kt" :: String) q++ , acceptableSource = parseURI =<< URL.lookup ("as" :: String) q+ , exactSource = parseURI =<< URL.lookup ("xs" :: String) q++ , tracker = parseURI =<< URL.lookup ("tr" :: String) q+ , supplement = M.empty+ }++ | otherwise = Left "exact topic not defined"++toQuery :: Magnet -> URLEncoded+toQuery Magnet {..}+ = s "xt" %= infoHashToURN exactTopic+ %& s "dn" %=? (T.unpack <$> displayName)+ %& s "xl" %=? exactLength+ %& s "mt" %=? manifest+ %& s "kt" %=? keywordTopic+ %& s "as" %=? acceptableSource+ %& s "xs" %=? exactSource+ %& s "tr" %=? tracker+ where+ s :: String -> String; s = id++magnetScheme :: URI+magnetScheme = URI+ { uriScheme = "magnet:"+ , uriAuthority = Nothing+ , uriPath = ""+ , uriQuery = ""+ , uriFragment = ""+ }++isMagnetURI :: URI -> Bool+isMagnetURI u = u { uriQuery = "" } == magnetScheme++-- | The same as 'parseMagnet' but useful if you alread have a parsed+-- uri.+fromURI :: URI -> Either String Magnet+fromURI u @ URI {..}+ | not (isMagnetURI u) = Left "this is not a magnet link"+ | otherwise = importURI u >>= fromQuery++-- | The same as 'renderMagnet' but useful if you need an uri.+toURI :: Magnet -> URI+toURI m = magnetScheme %? urlEncode m++etom :: Either a b -> Maybe b+etom = either (const Nothing) Just++-- | Try to parse magnet link from urlencoded string.+parseMagnet :: String -> Maybe Magnet+parseMagnet = parseURI >=> etom . fromURI++-- | Render magnet link to urlencoded string+renderMagnet :: Magnet -> String+renderMagnet = show . toURI
+ src/Data/Torrent/Piece.hs view
@@ -0,0 +1,226 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Pieces are used to validate torrent content.+--+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.Torrent.Piece+ ( -- * Piece attributes+ PieceIx+ , PieceCount+ , PieceSize+ , minPieceSize+ , maxPieceSize+ , defaultPieceSize++ -- * Piece data+ , Piece (..)+ , ppPiece+ , pieceSize+ , isPiece++ -- * Piece control+ , PieceInfo (..)+ , ppPieceInfo+ , pieceCount++ -- * Lens+ , pieceLength+ , pieceHashes++ -- * Validation+ , pieceHash+ , checkPieceLazy++ -- * Internal+ , getPieceInfo+ , putPieceInfo+ ) where++import Control.DeepSeq+import Control.Lens+import qualified Crypto.Hash.SHA1 as SHA1+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), withText)+import Data.Aeson.TH+import Data.BEncode+import Data.BEncode.Types+import Data.Bits+import Data.Bits.Extras+import Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Base64 as Base64+import Data.Char+import Data.Int+import Data.List as L+import Data.Text.Encoding as T+import Data.Typeable+import Text.PrettyPrint++import Data.Torrent.Block+++class Lint a where+ lint :: a -> Either String a++--class Validation a where+-- validate :: PieceInfo -> Piece a -> Bool++{-----------------------------------------------------------------------+-- Piece attributes+-----------------------------------------------------------------------}++-- | Number of pieces in torrent or a part of torrent.+type PieceCount = Int++-- | Optimal number of pieces in torrent.+optimalPieceCount :: PieceCount+optimalPieceCount = 1000+{-# INLINE optimalPieceCount #-}++-- | Piece size should not be less than this value.+minPieceSize :: Int+minPieceSize = defaultTransferSize * 4+{-# INLINE minPieceSize #-}++-- | To prevent transfer degradation piece size should not exceed this+-- value.+maxPieceSize :: Int+maxPieceSize = 4 * 1024 * 1024+{-# INLINE maxPieceSize #-}++toPow2 :: Int -> Int+toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)++-- | Find the optimal piece size for a given torrent size.+defaultPieceSize :: Int64 -> Int+defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc+ where+ pc = fromIntegral (x `div` fromIntegral optimalPieceCount)++{-----------------------------------------------------------------------+-- Piece data+-----------------------------------------------------------------------}++-- TODO check if pieceLength is power of 2+-- | Piece payload should be strict or lazy bytestring.+data Piece a = Piece+ { -- | Zero-based piece index in torrent.+ pieceIndex :: {-# UNPACK #-} !PieceIx++ -- | Payload.+ , pieceData :: !a+ } deriving (Show, Read, Eq, Typeable)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece)++instance NFData (Piece a)++-- | Format piece in human readable form. Payload bytes are omitted.+ppPiece :: Piece a -> Doc+ppPiece Piece {..}+ = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)++-- | Get size of piece in bytes.+pieceSize :: Piece BL.ByteString -> PieceSize+pieceSize Piece {..} = fromIntegral (BL.length pieceData)++-- | Test if a block can be safely turned into a piece.+isPiece :: PieceSize -> Block BL.ByteString -> Bool+isPiece pieceLen blk @ (Block i offset _) =+ offset == 0 && blockSize blk == pieceLen && i >= 0+{-# INLINE isPiece #-}++{-----------------------------------------------------------------------+-- Piece control+-----------------------------------------------------------------------}++newtype HashArray = HashArray { unHashArray :: ByteString }+ deriving (Show, Read, Eq, BEncode)++-- | Represented as base64 encoded JSON string.+instance ToJSON HashArray where+ toJSON (HashArray bs) = String $ T.decodeUtf8 $ Base64.encode bs++instance FromJSON HashArray where+ parseJSON = withText "HashArray" $+ either fail (return . HashArray) . Base64.decode . T.encodeUtf8++-- | Part of torrent file used for torrent content validation.+data PieceInfo = PieceInfo+ { piPieceLength :: {-# UNPACK #-} !PieceSize+ -- ^ Number of bytes in each piece.++ , piPieceHashes :: !HashArray+ -- ^ Concatenation of all 20-byte SHA1 hash values.+ } deriving (Show, Read, Eq, Typeable)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PieceInfo)++-- | Number of bytes in each piece.+makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo++-- | Concatenation of all 20-byte SHA1 hash values.+makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo++instance NFData PieceInfo++instance Lint PieceInfo where+ lint pinfo @ PieceInfo {..}+ | BS.length (unHashArray piPieceHashes) `rem` hashsize == 0+ , piPieceLength >= 0 = return pinfo+ | otherwise = Left undefined+++putPieceInfo :: PieceInfo -> BDict -> BDict+putPieceInfo PieceInfo {..} cont =+ "piece length" .=! piPieceLength+ .: "pieces" .=! piPieceHashes+ .: cont++getPieceInfo :: Get PieceInfo+getPieceInfo = do+ PieceInfo <$>! "piece length"+ <*>! "pieces"++instance BEncode PieceInfo where+ toBEncode = toDict . (`putPieceInfo` endDict)+ fromBEncode = fromDict getPieceInfo++-- | Format piece info in human readable form. Hashes are omitted.+ppPieceInfo :: PieceInfo -> Doc+ppPieceInfo PieceInfo { piPieceLength = len } =+ "PieceInfo" <+> braces ("length" <+> "=" <+> int len)++hashsize :: Int+hashsize = 20+{-# INLINE hashsize #-}++slice :: Int -> Int -> ByteString -> ByteString+slice start len = BS.take len . BS.drop start+{-# INLINE slice #-}++-- | Extract validation hash by specified piece index.+pieceHash :: PieceInfo -> PieceIx -> ByteString+pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashArray piPieceHashes)++-- | Find count of pieces in the torrent. If torrent size is not a+-- multiple of piece size then the count is rounded up.+pieceCount :: PieceInfo -> PieceCount+pieceCount PieceInfo {..} = BS.length (unHashArray piPieceHashes) `quot` hashsize++-- | Test if this is last piece in torrent content.+isLastPiece :: PieceInfo -> PieceIx -> Bool+isLastPiece ci i = pieceCount ci == succ i++-- | Validate piece with metainfo hash.+checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool+checkPieceLazy pinfo @ PieceInfo {..} Piece {..}+ = (fromIntegral (BL.length pieceData) == piPieceLength+ || isLastPiece pinfo pieceIndex)+ && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
+ src/Data/Torrent/Tree.hs view
@@ -0,0 +1,81 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Directory tree can be used to easily manipulate file layout info.+--+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Data.Torrent.Tree+ ( -- * Directory tree+ DirTree (..)++ -- * Construction+ , build++ -- * Query+ , Data.Torrent.Tree.lookup+ , lookupDir+ , fileNumber+ , dirNumber+ ) where++import Data.ByteString as BS+import Data.ByteString.Char8 as BC+import Data.Foldable+import Data.List as L+import Data.Map as M+import Data.Monoid++import Data.Torrent.Layout+++-- | 'DirTree' is more convenient form of 'LayoutInfo'.+data DirTree a = Dir { children :: Map ByteString (DirTree a) }+ | File { node :: FileInfo a }+ deriving Show++-- | Build directory tree from a list of files.+build :: LayoutInfo -> DirTree ()+build SingleFile {liFile = FileInfo {..}} = Dir+ { children = M.singleton fiName (File fi) }+ where+ fi = FileInfo fiLength fiMD5Sum ()+build MultiFile {..} = Dir $ M.singleton liDirName files+ where+ files = Dir $ M.fromList $ L.map mkFileEntry liFiles+ mkFileEntry FileInfo {..} = (L.head fiName, ent) -- TODO FIXME+ where+ ent = File $ FileInfo fiLength fiMD5Sum ()++--decompress :: DirTree () -> [FileInfo ()]+--decompress = undefined++-- | Lookup file by path.+lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)+lookup [] t = Just t+lookup (p : ps) (Dir m) | Just subTree <- M.lookup (BC.pack p) m+ = Data.Torrent.Tree.lookup ps subTree+lookup _ _ = Nothing++-- | Lookup directory by path.+lookupDir :: [FilePath] -> DirTree a -> Maybe [(ByteString, DirTree a)]+lookupDir ps d = do+ subTree <- Data.Torrent.Tree.lookup ps d+ case subTree of+ File _ -> Nothing+ Dir es -> Just $ M.toList es++-- | Get total count of files in directory and subdirectories.+fileNumber :: DirTree a -> Sum Int+fileNumber File {..} = Sum 1+fileNumber Dir {..} = foldMap fileNumber children++-- | Get total count of directories in the directory and subdirectories.+dirNumber :: DirTree a -> Sum Int+dirNumber File {..} = Sum 0+dirNumber Dir {..} = Sum 1 <> foldMap dirNumber children
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}