module Data.Torrent.Layout
(
FileOffset
, FileSize
, FileInfo (..)
, fileLength
, filePath
, fileMD5Sum
, LayoutInfo (..)
, joinFilePath
, singleFile
, multiFile
, rootDirName
, isSingleFile
, isMultiFile
, suggestedName
, contentLength
, fileCount
, blockCount
, Layout
, flatLayout
, accumOffsets
, fileOffset
, 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 as Char
import Data.Foldable as F
import Data.List as L
import Data.Text as T
import Data.Text.Encoding as T
import Data.Typeable
import Text.PrettyPrint as PP
import Text.PrettyPrint.Class
import System.FilePath
import System.Posix.Types
import Data.Torrent.Block
import Data.Torrent.InfoHash
type FileSize = FileOffset
deriving instance FromJSON FileOffset
deriving instance ToJSON FileOffset
deriving instance BEncode FileOffset
data FileInfo a = FileInfo {
fiLength :: !FileSize
, fiMD5Sum :: !(Maybe ByteString)
, fiName :: !a
} deriving (Show, Read, Eq, Typeable
, Functor, Foldable
)
$(deriveJSON (L.map Char.toLower . L.dropWhile isLower) ''FileInfo)
makeLensesFor
[ ("fiLength", "fileLength")
, ("fiMD5Sum", "fileMD5Sum")
, ("fiName" , "filePath" )
]
''FileInfo
instance NFData a => NFData (FileInfo a) where
rnf FileInfo {..} = rnf fiName
instance BEncode (FileInfo [ByteString]) where
toBEncode FileInfo {..} = toDict $
"length" .=! fiLength
.: "md5sum" .=? fiMD5Sum
.: "path" .=! fiName
.: endDict
fromBEncode = fromDict $ do
FileInfo <$>! "length"
<*>? "md5sum"
<*>! "path"
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)
fromBEncode = fromDict getFileInfoSingle
instance Pretty (FileInfo BS.ByteString) where
pretty FileInfo {..} =
"Path: " <> text (T.unpack (T.decodeUtf8 fiName))
$$ "Size: " <> text (show fiLength)
$$ maybe PP.empty ppMD5 fiMD5Sum
where
ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5))
joinFilePath :: FileInfo [ByteString] -> FileInfo ByteString
joinFilePath = fmap (BS.intercalate "/")
data LayoutInfo
= SingleFile
{
liFile :: !(FileInfo ByteString)
}
| MultiFile
{
liFiles :: ![FileInfo [ByteString]]
, liDirName :: !ByteString
} deriving (Show, Read, Eq, Typeable)
$(deriveJSON (L.map Char.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
instance Pretty LayoutInfo where
pretty SingleFile {..} = pretty liFile
pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles
isSingleFile :: LayoutInfo -> Bool
isSingleFile SingleFile {} = True
isSingleFile _ = False
isMultiFile :: LayoutInfo -> Bool
isMultiFile MultiFile {} = True
isMultiFile _ = False
suggestedName :: LayoutInfo -> ByteString
suggestedName (SingleFile FileInfo {..}) = fiName
suggestedName MultiFile {..} = liDirName
contentLength :: LayoutInfo -> FileSize
contentLength SingleFile { liFile = FileInfo {..} } = fiLength
contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs)
fileCount :: LayoutInfo -> Int
fileCount SingleFile {..} = 1
fileCount MultiFile {..} = L.length liFiles
blockCount :: BlockSize -> LayoutInfo -> Int
blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
type Layout a = [(FilePath, a)]
flatLayout
:: FilePath
-> LayoutInfo
-> Layout FileSize
flatLayout prefixPath SingleFile { liFile = FileInfo {..} }
= [(prefixPath </> BC.unpack fiName, fiLength)]
flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles
where
mkPath FileInfo {..} = (path, fiLength)
where
path = prefixPath </> BC.unpack liDirName
</> joinPath (L.map BC.unpack fiName)
accumOffsets :: Layout FileSize -> Layout FileOffset
accumOffsets = go 0
where
go !_ [] = []
go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs
fileOffset :: FilePath -> Layout FileOffset -> Maybe FileOffset
fileOffset = lookup
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