From 01cef3fafc27d39d88c94cacdcd8e204c5f66b86 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Thu, 31 Oct 2013 11:25:59 +0400 Subject: Merge bittorrent package with torrent-content --- src/Data/Torrent.hs | 273 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 273 insertions(+) create mode 100644 src/Data/Torrent.hs (limited to 'src/Data/Torrent.hs') diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs new file mode 100644 index 00000000..15ada35f --- /dev/null +++ b/src/Data/Torrent.hs @@ -0,0 +1,273 @@ +-- | +-- 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 -- cgit v1.2.3