-- | -- 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: -- , -- -- {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -fno-warn-orphans #-} -- TODO refine interface module Data.Torrent ( -- * Info dictionary InfoDict (..) , infohash , layoutInfo , pieceInfo , isPrivate -- * Torrent file , Torrent(..) , announce , announceList , comment , createdBy , creationDate , encoding , infoDict , publisher , publisherURL , signature , nullTorrent -- * IO , torrentExt , isTorrentPath , fromFile , toFile {- , nullTorrent , mktorrent -} ) where import Prelude hiding (sum) import Control.Applicative import Control.DeepSeq import Control.Exception import Control.Lens 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 import Data.Hashable as Hashable import qualified Data.List as L import Data.Text (Text) 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: } deriving (Show, Read, Eq, Typeable) $(deriveJSON (L.map 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: , 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) 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