-- | BitTorrent metainfo files
--
-- <http://www.bittorrent.org/beps/bep_0003.html>

{-# LANGUAGE DeriveDataTypeable #-}

module Data.Torrent
	( Torrent(..)
	, TorrentInfo(..)
	, TorrentFile(..)
	, readTorrent
	, serializeTorrent
	, torrentSize
	, showTorrent
	) where

import Data.BEncode
import Data.BEncode.Reader
import Data.Binary
import Data.Generics
import Data.Maybe
import Control.Applicative

import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Lazy (ByteString)

import qualified Data.Map as Map

data Torrent
	= Torrent
		{ Torrent -> Maybe ByteString
tAnnounce     :: Maybe ByteString
		, Torrent -> [ByteString]
tAnnounceList :: [ByteString]
		, Torrent -> ByteString
tComment      :: ByteString
		, Torrent -> Maybe ByteString
tCreatedBy    :: Maybe ByteString
		, Torrent -> TorrentInfo
tInfo         :: TorrentInfo
		}
	deriving (Int -> Torrent -> ShowS
[Torrent] -> ShowS
Torrent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Torrent] -> ShowS
$cshowList :: [Torrent] -> ShowS
show :: Torrent -> String
$cshow :: Torrent -> String
showsPrec :: Int -> Torrent -> ShowS
$cshowsPrec :: Int -> Torrent -> ShowS
Show, ReadPrec [Torrent]
ReadPrec Torrent
Int -> ReadS Torrent
ReadS [Torrent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Torrent]
$creadListPrec :: ReadPrec [Torrent]
readPrec :: ReadPrec Torrent
$creadPrec :: ReadPrec Torrent
readList :: ReadS [Torrent]
$creadList :: ReadS [Torrent]
readsPrec :: Int -> ReadS Torrent
$creadsPrec :: Int -> ReadS Torrent
Read, Typeable, Typeable Torrent
Torrent -> DataType
Torrent -> Constr
(forall b. Data b => b -> b) -> Torrent -> Torrent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
gmapT :: (forall b. Data b => b -> b) -> Torrent -> Torrent
$cgmapT :: (forall b. Data b => b -> b) -> Torrent -> Torrent
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
dataTypeOf :: Torrent -> DataType
$cdataTypeOf :: Torrent -> DataType
toConstr :: Torrent -> Constr
$ctoConstr :: Torrent -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
Data)

data TorrentInfo
	= SingleFile
		{ TorrentInfo -> Integer
tLength      :: Integer
		, TorrentInfo -> ByteString
tName        :: ByteString
		, TorrentInfo -> Integer
tPieceLength :: Integer
		, TorrentInfo -> ByteString
tPieces      :: ByteString }
	| MultiFile
		{ TorrentInfo -> [TorrentFile]
tFiles       :: [TorrentFile]
		, tName        :: ByteString
		, tPieceLength :: Integer
		, tPieces      :: ByteString
		}
	deriving (Int -> TorrentInfo -> ShowS
[TorrentInfo] -> ShowS
TorrentInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TorrentInfo] -> ShowS
$cshowList :: [TorrentInfo] -> ShowS
show :: TorrentInfo -> String
$cshow :: TorrentInfo -> String
showsPrec :: Int -> TorrentInfo -> ShowS
$cshowsPrec :: Int -> TorrentInfo -> ShowS
Show, ReadPrec [TorrentInfo]
ReadPrec TorrentInfo
Int -> ReadS TorrentInfo
ReadS [TorrentInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TorrentInfo]
$creadListPrec :: ReadPrec [TorrentInfo]
readPrec :: ReadPrec TorrentInfo
$creadPrec :: ReadPrec TorrentInfo
readList :: ReadS [TorrentInfo]
$creadList :: ReadS [TorrentInfo]
readsPrec :: Int -> ReadS TorrentInfo
$creadsPrec :: Int -> ReadS TorrentInfo
Read, Typeable, Typeable TorrentInfo
TorrentInfo -> DataType
TorrentInfo -> Constr
(forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
gmapT :: (forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
$cgmapT :: (forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
dataTypeOf :: TorrentInfo -> DataType
$cdataTypeOf :: TorrentInfo -> DataType
toConstr :: TorrentInfo -> Constr
$ctoConstr :: TorrentInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
Data)

data TorrentFile
	= TorrentFile
		{ TorrentFile -> Integer
fileLength :: Integer
		, TorrentFile -> [ByteString]
filePath   :: [ByteString]
		}
	deriving (Int -> TorrentFile -> ShowS
[TorrentFile] -> ShowS
TorrentFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TorrentFile] -> ShowS
$cshowList :: [TorrentFile] -> ShowS
show :: TorrentFile -> String
$cshow :: TorrentFile -> String
showsPrec :: Int -> TorrentFile -> ShowS
$cshowsPrec :: Int -> TorrentFile -> ShowS
Show, ReadPrec [TorrentFile]
ReadPrec TorrentFile
Int -> ReadS TorrentFile
ReadS [TorrentFile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TorrentFile]
$creadListPrec :: ReadPrec [TorrentFile]
readPrec :: ReadPrec TorrentFile
$creadPrec :: ReadPrec TorrentFile
readList :: ReadS [TorrentFile]
$creadList :: ReadS [TorrentFile]
readsPrec :: Int -> ReadS TorrentFile
$creadsPrec :: Int -> ReadS TorrentFile
Read, Typeable, Typeable TorrentFile
TorrentFile -> DataType
TorrentFile -> Constr
(forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
gmapT :: (forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
$cgmapT :: (forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
dataTypeOf :: TorrentFile -> DataType
$cdataTypeOf :: TorrentFile -> DataType
toConstr :: TorrentFile -> Constr
$ctoConstr :: TorrentFile -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
Data)

instance Binary Torrent where
	put :: Torrent -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Torrent -> BEncode
serializeTorrent
	get :: Get Torrent
get = do
		ByteString
e <- forall t. Binary t => Get t
get
		case ByteString -> Either String Torrent
readTorrent ByteString
e of
			Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse torrent: " forall a. [a] -> [a] -> [a]
++ String
err
			Right Torrent
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return Torrent
t

-- | Size of the files in the torrent.
torrentSize :: Torrent -> Integer
torrentSize :: Torrent -> Integer
torrentSize Torrent
torrent = case Torrent -> TorrentInfo
tInfo Torrent
torrent of
	s :: TorrentInfo
s@SingleFile{} -> TorrentInfo -> Integer
tLength TorrentInfo
s
	MultiFile{tFiles :: TorrentInfo -> [TorrentFile]
tFiles=[TorrentFile]
files} -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map TorrentFile -> Integer
fileLength [TorrentFile]
files)

readTorrent :: ByteString -> Either String Torrent
readTorrent :: ByteString -> Either String Torrent
readTorrent ByteString
inp = case ByteString -> Maybe BEncode
bRead ByteString
inp of
	Maybe BEncode
Nothing -> forall a b. a -> Either a b
Left String
"Not BEncoded"
	Just BEncode
be -> forall a. BReader a -> BEncode -> Either String a
runBReader BReader Torrent
parseTorrent BEncode
be

parseTorrent :: BReader Torrent
parseTorrent :: BReader Torrent
parseTorrent = do
	Maybe ByteString
announce <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a. String -> BReader a -> BReader a
dict String
"announce" BReader ByteString
bbytestring
	Maybe ByteString
creator <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a. String -> BReader a -> BReader a
dict String
"created by" BReader ByteString
bbytestring
	forall a. String -> BReader a -> BReader a
dict String
"info" forall a b. (a -> b) -> a -> b
$ do
		ByteString
name <- forall a. String -> BReader a -> BReader a
dict String
"name" BReader ByteString
bbytestring
		Integer
pLen <- forall a. String -> BReader a -> BReader a
dict String
"piece length" BReader Integer
bint
		ByteString
pieces <- forall a. String -> BReader a -> BReader a
dict String
"pieces" BReader ByteString
bbytestring
		TorrentInfo
torrentInfo <- ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo ByteString
name Integer
pLen ByteString
pieces
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> [ByteString]
-> ByteString
-> Maybe ByteString
-> TorrentInfo
-> Torrent
Torrent Maybe ByteString
announce [] ByteString
BS.empty Maybe ByteString
creator TorrentInfo
torrentInfo

parseTorrentInfo :: ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo :: ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo ByteString
name Integer
pLen ByteString
pieces = BReader TorrentInfo
single forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BReader TorrentInfo
multi
  where
	single :: BReader TorrentInfo
single = do
		Integer
len <- forall a. String -> BReader a -> BReader a
dict String
"length" BReader Integer
bint
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> ByteString -> Integer -> ByteString -> TorrentInfo
SingleFile Integer
len ByteString
name Integer
pLen ByteString
pieces
	multi :: BReader TorrentInfo
multi = do
		[TorrentFile]
files <- forall a. String -> BReader a -> BReader a
dict String
"files" forall a b. (a -> b) -> a -> b
$ forall a. BReader a -> BReader [a]
list forall a b. (a -> b) -> a -> b
$ do
			Integer
len <- forall a. String -> BReader a -> BReader a
dict String
"length" BReader Integer
bint
			[ByteString]
filePaths <- forall a. String -> BReader a -> BReader a
dict String
"path" (forall a. BReader a -> BReader [a]
list BReader ByteString
bbytestring)
			forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> [ByteString] -> TorrentFile
TorrentFile Integer
len [ByteString]
filePaths
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [TorrentFile] -> ByteString -> Integer -> ByteString -> TorrentInfo
MultiFile [TorrentFile]
files ByteString
name Integer
pLen ByteString
pieces

serializeTorrent :: Torrent -> BEncode
serializeTorrent :: Torrent -> BEncode
serializeTorrent Torrent
torrent = Map String BEncode -> BEncode
BDict forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
	[ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
b -> (String
"announce", ByteString -> BEncode
BString ByteString
b)) (Torrent -> Maybe ByteString
tAnnounce Torrent
torrent)
	, forall a. a -> Maybe a
Just (String
"comment", ByteString -> BEncode
BString forall a b. (a -> b) -> a -> b
$ Torrent -> ByteString
tComment Torrent
torrent)
	, forall a. a -> Maybe a
Just (String
"info", BEncode
info)
	]
  where
	info :: BEncode
info = Map String BEncode -> BEncode
BDict forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
		[ (String
"name", ByteString -> BEncode
BString forall a b. (a -> b) -> a -> b
$ TorrentInfo -> ByteString
tName (Torrent -> TorrentInfo
tInfo Torrent
torrent))
		, (String
"pieces", ByteString -> BEncode
BString forall a b. (a -> b) -> a -> b
$ TorrentInfo -> ByteString
tPieces (Torrent -> TorrentInfo
tInfo Torrent
torrent))
		, (String
"piece length", Integer -> BEncode
BInt forall a b. (a -> b) -> a -> b
$ TorrentInfo -> Integer
tPieceLength (Torrent -> TorrentInfo
tInfo Torrent
torrent))
		] forall a. [a] -> [a] -> [a]
++ case Torrent -> TorrentInfo
tInfo Torrent
torrent of
			SingleFile Integer
len ByteString
_ Integer
_ ByteString
_ ->
				[ (String
"length", Integer -> BEncode
BInt Integer
len) ]
			MultiFile [TorrentFile]
files ByteString
_ Integer
_ ByteString
_ ->
				[ (String
"files", [BEncode] -> BEncode
BList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TorrentFile -> BEncode
serfile [TorrentFile]
files) ]

	serfile :: TorrentFile -> BEncode
serfile TorrentFile
file = Map String BEncode -> BEncode
BDict forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
		[ (String
"length", Integer -> BEncode
BInt (TorrentFile -> Integer
fileLength TorrentFile
file))
		, (String
"path", [BEncode] -> BEncode
BList (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> BEncode
BString forall a b. (a -> b) -> a -> b
$ TorrentFile -> [ByteString]
filePath TorrentFile
file))
		]

-- | generates a torrent file
--
-- Due to lexographical ordering requirements of BEncoded data, this
-- should generate the same ByteString that readTorrent read to generate
-- the Torrent. However, torrent files may contain extensions and
-- nonstandard fields that prevent that from holding for all torrent files.
showTorrent :: Torrent -> ByteString
showTorrent :: Torrent -> ByteString
showTorrent = BEncode -> ByteString
bPack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Torrent -> BEncode
serializeTorrent