Torrent.hs

{-

 Copyright (c) 2005 Jesper Louis Andersen <jlouis@mongers.org>

 Permission to use, copy, modify, and distribute this software for any
 purpose with or without fee is hereby granted, provided that the above
 copyright notice and this permission notice appear in all copies.

 THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Torrent
-- Copyright   :  (c) Jesper Louis Andersen, 2005
--                (c) Lemmih, 2005-2006
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  believed to be stable
-- Portability :  portable
--
-- This module provides the basic one abstraction of Conjure. A Torrent
-- type is the basic type of torrents, which the rest of the software
-- uses to identify and manipulate torrent files. They are actually
-- nothing more than simple BEncoded strings, built into ASTs and kept
-- inside the Torrent type.
--
-- Several logical operations are available on Torrent types. These
-- allow the programmer to work on Torrents and retrieve information
-- about them, without having to dig around inside the structure
-- manually.
-----------------------------------------------------------------------------
module Conjure.Torrent
    ( getPieceFilePaths -- :: Torrent -> Int -> [(FilePath,Int,Int)]
    , getBlockFilePaths -- :: Torrent -> Int -> Int -> Int -> [(FilePath,Int,Int)]
    , pieceLength       -- :: Torrent -> Int -> Int
    , pieceCheckSum     -- :: Torrent -> Int -> ByteString
    , infoNumPieces     -- :: Torrent -> Int
    , infoTotalBytes    -- :: Torrent -> Integer
    , readTorrentFile   -- :: FilePath -> IO (Either String Torrent)
    ) where

import BEncode.BEncode as BE
import BEncode.BParser
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Conjure.Utils.SHA1 (sha1)

import Control.Monad

import Data.List

import System.FilePath
import Network.URI

import Conjure.Types

buri :: BParser BEncode -> BParser URI
buri p = do str <- bstring p
            case parseURI str of
              Nothing -> fail $ "Expected URI: " ++ str
              Just uri -> return uri

parseTorrent :: BParser Torrent
parseTorrent =
    do announce <- buri $ dict "announce"
       creator  <- optional $ bstring $ dict "created by"
       info     <- dict "info"
       setInput info
       name     <- bstring $ dict "name"
       pLen     <- bint $ dict "piece length"
       pieces   <- bfaststring $ dict "pieces"
       torrentInfo      <- parseTorrentInfo name pLen pieces
       let infoHash = sha1 (BS.pack $ BE.bShow info "")
       return $ Torrent announce [] "" creator torrentInfo infoHash

parseTorrentInfo :: String -> Int -> ByteString -> BParser TorrentInfo
parseTorrentInfo name pLen pieces
    = do len <- bint $ dict "length"
         return $ SingleFile len name pLen pieces
      <|>
      do files <- list "files" $ do len <- bint $ dict "length"
                                    filePaths <- list "path" $ bstring token
                                    return $ TorrentFile len (joinPath filePaths)
         return $ MultiFile files name pLen pieces


-- | The size of a SHA1 Sum. It should probably be defined elsewhere
sizeSHA :: Int
sizeSHA = 20

-- | Assume that the given String is a Torrent file and attempt to read
--   it in. The function return Left err if it was impossible to validate
--   the String as a torrent file and Right Torrent in the case where the
--   torrent file could be parsed.
readTorrent :: ByteString -> Either String Torrent
readTorrent str
    = case BE.bRead str of
        Just be -> runParser parseTorrent be
        Nothing -> Left "String is not BEncoded."

-- | Assume the file pointed to by the FilePath is a torrent file
--   and attempt to read it.
readTorrentFile :: FilePath -> IO (Either String Torrent)
readTorrentFile = (liftM readTorrent) . BS.readFile

-- | Length of particular piece (all except the last one are the same)
pieceLength :: Torrent -> Int -> Int
pieceLength t p | p < (infoNumPieces t)-1 = tPieceLength (tInfo t)
pieceLength t _ | otherwise               = fromIntegral $ infoTotalBytes t `mod` fromIntegral (tPieceLength (tInfo t))

infoTotalBytes :: Torrent -> Integer
infoTotalBytes t = sum $ map (fromIntegral.snd) $ fileInfo t

infoPieces :: Torrent -> ByteString
infoPieces = tPieces . tInfo

pieceCheckSum :: Torrent -> Int -> ByteString
pieceCheckSum t n = BS.take 20 (BS.drop (n*20) (infoPieces t))

-- | Calculate the number of Pieces of a given Torrent file
infoNumPieces :: Torrent -> Int
infoNumPieces t = (BS.length . infoPieces) t `div` sizeSHA

-- | Find wanted blocks from a greater whole.
-- Used for picking pieces out of files and blocks out of pieces.
findBlocks :: Int -> Int -> [(FilePath, Int, Int)] -> [(FilePath, Int, Int)]
findBlocks blockStart blockLen units
    = worker 0 units
    where worker unitStart []
              | unitStart < blockLen = error "Conjure.Torrent.findBlocks: Block exceeded unit space"
              | otherwise = []
          worker unitStart ((pth,unitOffset,unitLen):xs)
              | blockEnd <= unitStart = []
              | blockStart < unitEnd
                  = let startPos = max 0 (blockStart-unitStart)
                        unitLen' = min blockEnd unitEnd - startPos - unitStart
                    in (pth, startPos+unitOffset, unitLen'):worker unitEnd xs
              | otherwise = worker unitEnd xs
              where unitEnd = unitStart + unitLen
          blockEnd = blockStart + blockLen

getPieceFilePaths :: Torrent -> Int -> [(FilePath,Int,Int)]
getPieceFilePaths torrent pieceNum
    = case tInfo torrent of
        SingleFile {tName = name} -> [(name,pieceStart,pieceLength torrent pieceNum)]
        MultiFile {tName = name
                  ,tFiles = files}
            -> let entries = map (\file -> (name </> filePath file, 0, fileLength file)) files
               in findBlocks pieceStart (pieceLength torrent pieceNum) entries
    where pLen = tPieceLength (tInfo torrent)
          pieceStart = pieceNum*pLen

getBlockFilePaths :: Torrent -> Int -> Int -> Int -> [(FilePath,Int,Int)]
getBlockFilePaths torrent pieceNum blockStart blockLength
    = findBlocks blockStart blockLength pieceEntries
    where pieceEntries = getPieceFilePaths torrent pieceNum

-- | Unpack the list of files in the torrent
fileInfo :: Torrent -> [(FilePath, Int)]
fileInfo t
    = case tInfo t of
        SingleFile { tLength = len, tName = name }
            -> [(name,len)]
        MultiFile { tFiles = files}
            -> map (\f -> (filePath f, fileLength f)) files