Merge bittorrent package with torrent-content

6 files changed, 1171 insertions, 0 deletions

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:
+--   <http://www.bittorrent.org/beps/bep_0003.html#metainfo-files>,
+--   <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure>
+--
+{-# 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: <http://www.bittorrent.org/beps/bep_0027.html>
+  } 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: <http://www.bittorrent.org/beps/bep_0012.html>
+
+  , 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
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
new file mode 100644
index 00000000..71ea0260
--- /dev/null
+++ b/src/Data/Torrent/InfoHash.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Torrent.InfoHash
+       ( -- * Info hash
+         InfoHash(..)
+       , addHashToURI
+       , ppInfoHash
+
+
+       , Data.Torrent.InfoHash.hash
+       , Data.Torrent.InfoHash.hashlazy
+       ) where
+
+import Control.Applicative
+import Control.Monad
+import qualified Crypto.Hash.SHA1 as C
+import Data.Aeson
+import Data.BEncode
+import Data.ByteString as BS
+import Data.ByteString.Char8 as BC
+import Data.ByteString.Lazy  as BL
+import Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Lazy.Builder as B
+import qualified Data.ByteString.Lazy.Builder.ASCII as B
+import Data.Char
+import Data.List       as L
+import Data.Hashable   as Hashable
+import Data.URLEncoded as URL
+import Data.Serialize
+import Data.String
+import Network.URI
+import Numeric
+import Text.ParserCombinators.ReadP as P
+import Text.PrettyPrint
+
+
+-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
+newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
+                   deriving (Eq, Ord, ToJSON, FromJSON)
+
+-- | for hex encoded strings
+instance Show InfoHash where
+  show = render . ppInfoHash
+
+-- | for hex encoded strings
+instance Read InfoHash where
+  readsPrec _ = readP_to_S $ do
+      str <- replicateM 40 (satisfy isHexDigit)
+      return $ InfoHash $ decodeIH str
+    where
+      decodeIH       = BS.pack . L.map fromHex . pair
+      fromHex (a, b) = read $ '0' : 'x' : a : b : []
+
+      pair (a : b : xs) = (a, b) : pair xs
+      pair _            = []
+
+-- | for base16 (hex) encoded strings
+instance IsString InfoHash where
+  fromString str
+    | L.length str == 40
+    , (ihStr, inv) <- Base16.decode $ BC.pack str
+    = if BS.length inv == 0 then InfoHash ihStr
+                      else error "fromString: invalid infohash string"
+    |       otherwise    = error "fromString: invalid infohash string length"
+
+instance Hashable InfoHash where
+  hash = Hashable.hash . getInfoHash
+
+instance BEncode InfoHash where
+  toBEncode = toBEncode . getInfoHash
+  fromBEncode be = InfoHash <$> fromBEncode be
+
+instance Serialize InfoHash where
+  put = putByteString . getInfoHash
+  get = InfoHash <$> getBytes 20
+
+instance URLShow InfoHash where
+  urlShow = show
+
+-- | Hash strict bytestring using SHA1 algorithm.
+hash :: BS.ByteString -> InfoHash
+hash = InfoHash . C.hash
+
+-- | Hash lazy bytestring using SHA1 algorithm.
+hashlazy :: BL.ByteString -> InfoHash
+hashlazy = InfoHash . C.hashlazy
+
+-- | Pretty print info hash in hexadecimal format.
+ppInfoHash :: InfoHash -> Doc
+ppInfoHash = text . BC.unpack . ppHex . getInfoHash
+
+ppHex :: BS.ByteString -> BS.ByteString
+ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed
+
+-- | Add query info hash parameter to uri.
+--
+--   > info_hash=<url_encoded_info_hash>
+--
+addHashToURI :: URI -> InfoHash -> URI
+addHashToURI uri s = uri {
+    uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++
+               "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s))
+  }
+  where
+    mkPref [] = "?"
+    mkPref ('?' : _) = "&"
+    mkPref _ = error "addHashToURI"
+
+    rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c)
+      where
+        unreservedS = (`L.elem` chars)
+        chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./"
+        encodeHex c = '%' : pHex c
+        pHex c = let p = (showHex . ord $ c) ""
+                 in if L.length p == 1 then '0' : p else p
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
new file mode 100644
index 00000000..409426be
--- /dev/null
+++ b/src/Data/Torrent/Layout.hs
@@ -0,0 +1,273 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# OPTIONS  -fno-warn-orphans          #-}
+module Data.Torrent.Layout
+       ( -- * File attribytes
+         FileOffset
+       , FileSize
+
+         -- * Single file info
+       , FileInfo (..)
+       , fileLength
+       , filePath
+       , fileMD5Sum
+
+         -- * File layout
+       , LayoutInfo (..)
+       , singleFile
+       , multiFile
+       , rootDirName
+       , isSingleFile
+       , isMultiFile
+       , fileNumber
+       , contentLength
+       , blockCount
+
+         -- * Flat file layout
+       , Layout
+       , flatLayout
+       , accumOffsets
+       , fileOffset
+
+         -- * Internal
+       , 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
+import Data.List as L
+import Data.Typeable
+import System.FilePath
+import System.Posix.Types
+
+
+{-----------------------------------------------------------------------
+--  File attribytes
+-----------------------------------------------------------------------}
+
+type FileSize = FileOffset
+
+deriving instance FromJSON FileOffset
+deriving instance ToJSON   FileOffset
+deriving instance BEncode  FileOffset
+
+{-----------------------------------------------------------------------
+--  File info both either from info dict or file list
+-----------------------------------------------------------------------}
+
+-- | Contain info about one single file.
+data FileInfo a = FileInfo {
+      fiLength      :: {-# UNPACK #-} !FileSize
+      -- ^ Length of the file in bytes.
+
+      -- TODO unpacked MD5 sum
+    , fiMD5Sum      :: !(Maybe ByteString)
+      -- ^ 32 character long MD5 sum of the file.  Used by third-party
+      -- tools, not by bittorrent protocol itself.
+
+    , fiName        :: !a
+      -- ^ One or more string elements that together represent the
+      --   path and filename. Each element in the list corresponds to
+      --   either a directory name or (in the case of the last
+      --   element) the filename.  For example, the file:
+      --
+      --   > "dir1/dir2/file.ext"
+      --
+      --   would consist of three string elements:
+      --
+      --   > ["dir1", "dir2", "file.ext"]
+      --
+    } deriving (Show, Read, Eq, Typeable)
+
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)
+
+makeLensesFor
+  [ ("fiLength", "fileLength")
+  , ("fiMD5Sum", "fileMD5Sum")
+  , ("fiName"  , "filePath"  )
+  ]
+  ''FileInfo
+
+instance NFData a => NFData (FileInfo a) where
+  rnf FileInfo {..} = rnf fiName
+  {-# INLINE rnf #-}
+
+instance BEncode (FileInfo [ByteString]) where
+  toBEncode FileInfo {..} = toDict $
+       "length" .=! fiLength
+    .: "md5sum" .=? fiMD5Sum
+    .: "path"   .=! fiName
+    .: endDict
+  {-# INLINE toBEncode #-}
+
+  fromBEncode = fromDict $ do
+    FileInfo <$>! "length"
+             <*>? "md5sum"
+             <*>! "path"
+  {-# INLINE fromBEncode #-}
+
+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)
+  {-# INLINE toBEncode #-}
+
+  fromBEncode = fromDict getFileInfoSingle
+  {-# INLINE fromBEncode #-}
+
+{-----------------------------------------------------------------------
+--  Original torrent file layout info
+-----------------------------------------------------------------------}
+
+data LayoutInfo
+  = SingleFile
+    { liFile     :: !(FileInfo ByteString)
+    }
+  | MultiFile
+    { -- | List of the all files that torrent contains.
+      liFiles    :: ![FileInfo [ByteString]]
+
+      -- | The /suggested/ name of the root directory in which to
+      -- store all the files.
+    , liDirName  :: !ByteString
+    } deriving (Show, Read, Eq, Typeable)
+
+$(deriveJSON (L.map 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
+
+-- | Test if this is single file torrent.
+isSingleFile :: LayoutInfo -> Bool
+isSingleFile SingleFile {} = True
+isSingleFile _             = False
+{-# INLINE isSingleFile #-}
+
+-- | Test if this is multifile torrent.
+isMultiFile :: LayoutInfo -> Bool
+isMultiFile MultiFile {} = True
+isMultiFile _            = False
+{-# INLINE isMultiFile #-}
+
+-- | Find sum of sizes of the all torrent files.
+contentLength :: LayoutInfo -> FileSize
+contentLength SingleFile { liFile  = FileInfo {..} } = fiLength
+contentLength MultiFile  { liFiles = tfs           } = sum (L.map fiLength tfs)
+
+-- | Get count of all files in torrent.
+fileNumber :: LayoutInfo -> Int
+fileNumber SingleFile {..} = 1
+fileNumber MultiFile  {..} = L.length liFiles
+
+-- | Find number of blocks of the specified size. If torrent size is
+-- not a multiple of block size then the count is rounded up.
+blockCount :: Int         -- ^ Block size.
+           -> LayoutInfo  -- ^ Torrent content info.
+           -> Int         -- ^ Number of blocks.
+blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
+
+{-----------------------------------------------------------------------
+--  Flat layout
+-----------------------------------------------------------------------}
+
+-- | File layout specifies the order and the size of each file in the
+--   storage. Note that order of files is highly important since we
+--   coalesce all the files in the given order to get the linear block
+--   address space.
+--
+type Layout a = [(FilePath, a)]
+
+-- | Extract files layout from torrent info with the given root path.
+flatLayout
+  :: FilePath        -- ^ Root path for the all torrent files.
+  -> LayoutInfo      -- ^ Torrent content information.
+  -> Layout FileSize -- ^ The all file paths prefixed with the given root.
+flatLayout prefixPath SingleFile { liFile = FileInfo {..} }
+    = [(prefixPath </> BC.unpack fiName, fiLength)]
+flatLayout prefixPath MultiFile  {..}     = L.map mkPath liFiles
+  where   -- TODO use utf8 encoding in name
+    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
+
+-- | Gives global offset of a content file for a given full path.
+fileOffset :: FilePath -> Layout FileOffset -> Maybe FileOffset
+fileOffset = lookup
+{-# INLINE fileOffset #-}
+
+{-----------------------------------------------------------------------
+-- Internal utilities
+-----------------------------------------------------------------------}
+
+-- | Divide and round up.
+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
+{-# SPECIALIZE sizeInBase :: Int -> Int -> Int #-}
+{-# SPECIALIZE sizeInBase :: Integer -> Int -> Int #-}
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
new file mode 100644
index 00000000..df928b66
--- /dev/null
+++ b/src/Data/Torrent/Magnet.hs
@@ -0,0 +1,236 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   Parsing and rendering of magnet URIs.
+--
+--   For more info see:
+--   <http://magnet-uri.sourceforge.net/magnet-draft-overview.txt>
+--
+--   Bittorrent specific info:
+--   <http://www.bittorrent.org/beps/bep_0009.html>
+--
+module Data.Torrent.Magnet
+       ( -- * Magnet
+         Magnet(..)
+       , nullMagnet
+       , parseMagnet
+       , renderMagnet
+
+         -- ** Extra
+       , fromURI
+       , toURI
+       ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString as BS
+import Data.ByteString.Base16 as Base16
+import Data.ByteString.Base32 as Base32
+import Data.Map as M
+import Data.Maybe
+import Data.List as L
+import Data.URLEncoded as URL
+import Data.String
+import Data.Text as T
+import Data.Text.Encoding as T
+import Network.URI
+import Text.Read
+
+import Data.Torrent.InfoHash
+
+
+{-----------------------------------------------------------------------
+-- URN
+-----------------------------------------------------------------------}
+
+type NamespaceId = [Text]
+
+btih :: NamespaceId
+btih  = ["btih"]
+
+-- | Uniform Resource Name - location-independent, resource
+-- identifier.
+data URN = URN
+    { urnNamespace :: NamespaceId
+    , urnString    :: Text
+    } deriving (Eq, Ord)
+
+instance Show URN where
+  showsPrec n = showsPrec n . T.unpack . renderURN
+
+instance IsString URN where
+  fromString = fromMaybe def . parseURN . T.pack
+    where
+      def = error "unable to parse URN"
+
+instance URLShow URN where
+  urlShow = T.unpack . renderURN
+
+parseURN :: Text -> Maybe URN
+parseURN str = case T.split (== ':') str of
+    uriScheme : body
+      | T.toLower uriScheme == "urn" -> mkURN body
+      |          otherwise           -> Nothing
+    [] -> Nothing
+  where
+    mkURN [] = Nothing
+    mkURN xs = Just $ URN
+        { urnNamespace = L.init xs
+        , urnString    = L.last xs
+        }
+
+renderURN :: URN -> Text
+renderURN URN {..}
+  = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]
+
+urnToInfoHash :: URN -> Maybe InfoHash
+urnToInfoHash  (URN {..})
+  | urnNamespace /= btih = Nothing
+  |      hashLen == 20   = Just $ InfoHash hashStr
+  |      hashLen == 32   = Just $ InfoHash $ Base32.decode hashStr
+  |      hashLen == 40   = let (ihStr, inv) = Base16.decode hashStr
+                           in if BS.length inv == 0
+                              then Just $ InfoHash ihStr
+                              else Nothing
+  |        otherwise     = Nothing
+  where
+    hashLen = BS.length hashStr
+    hashStr = T.encodeUtf8 urnString
+
+infoHashToURN :: InfoHash -> URN
+infoHashToURN = URN btih . T.pack . show
+
+{-----------------------------------------------------------------------
+--  Magnet
+-----------------------------------------------------------------------}
+
+-- TODO multiple exact topics
+-- TODO supplement
+
+-- | An URI used to identify torrent.
+data Magnet = Magnet
+    { -- | Resource hash.
+      exactTopic  :: !InfoHash
+      -- | Might be used to display name while waiting for metadata.
+    , displayName :: Maybe Text
+      -- | Size of the resource in bytes.
+    , exactLength :: Maybe Integer
+
+    , manifest :: Maybe String
+      -- | Search string.
+    , keywordTopic :: Maybe String
+
+    , acceptableSource :: Maybe URI
+    , exactSource      :: Maybe URI
+
+    , tracker :: Maybe URI
+
+    , supplement :: Map Text Text
+    } deriving (Eq, Ord)
+
+instance Show Magnet where
+  show = renderMagnet
+  {-# INLINE show #-}
+
+instance Read Magnet where
+  readsPrec _ xs
+      | Just m <- parseMagnet mstr = [(m, rest)]
+      | otherwise = []
+    where
+      (mstr, rest) = L.break (== ' ') xs
+
+instance IsString Magnet where
+  fromString = fromMaybe def . parseMagnet
+    where
+      def = error "unable to parse magnet"
+
+instance URLEncode Magnet where
+  urlEncode = toQuery
+  {-# INLINE urlEncode #-}
+
+-- | Set exact topic only, other params are empty.
+nullMagnet :: InfoHash -> Magnet
+nullMagnet u = Magnet
+    { exactTopic   = u
+    , displayName  = Nothing
+    , exactLength  = Nothing
+    , manifest     = Nothing
+    , keywordTopic = Nothing
+    , acceptableSource = Nothing
+    , exactSource      = Nothing
+    , tracker    = Nothing
+    , supplement = M.empty
+    }
+
+fromQuery :: URLEncoded -> Either String Magnet
+fromQuery q
+  | Just urnStr   <- URL.lookup ("xt" :: String) q
+  , Just urn      <- parseURN $ T.pack urnStr
+  , Just infoHash <- urnToInfoHash urn
+  = return $ Magnet
+      { exactTopic  = infoHash
+      , displayName = T.pack    <$> URL.lookup ("dn" :: String) q
+      , exactLength = readMaybe =<< URL.lookup ("xl" :: String) q
+
+      , manifest     = URL.lookup ("mt" :: String) q
+      , keywordTopic = URL.lookup ("kt" :: String) q
+
+      , acceptableSource = parseURI =<< URL.lookup ("as" :: String) q
+      , exactSource      = parseURI =<< URL.lookup ("xs" :: String) q
+
+      , tracker    = parseURI =<< URL.lookup ("tr" :: String) q
+      , supplement = M.empty
+      }
+
+  | otherwise = Left "exact topic not defined"
+
+toQuery :: Magnet -> URLEncoded
+toQuery Magnet {..}
+    =  s "xt" %=  infoHashToURN exactTopic
+    %& s "dn" %=? (T.unpack <$> displayName)
+    %& s "xl" %=? exactLength
+    %& s "mt" %=? manifest
+    %& s "kt" %=? keywordTopic
+    %& s "as" %=? acceptableSource
+    %& s "xs" %=? exactSource
+    %& s "tr" %=? tracker
+  where
+    s :: String -> String; s = id
+
+magnetScheme :: URI
+magnetScheme = URI
+    { uriScheme    = "magnet:"
+    , uriAuthority = Nothing
+    , uriPath      = ""
+    , uriQuery     = ""
+    , uriFragment  = ""
+    }
+
+isMagnetURI :: URI -> Bool
+isMagnetURI u = u { uriQuery = "" } == magnetScheme
+
+-- | The same as 'parseMagnet' but useful if you alread have a parsed
+-- uri.
+fromURI :: URI -> Either String Magnet
+fromURI u @ URI {..}
+  | not (isMagnetURI u) = Left "this is not a magnet link"
+  |      otherwise      = importURI u >>= fromQuery
+
+-- | The same as 'renderMagnet' but useful if you need an uri.
+toURI :: Magnet -> URI
+toURI m = magnetScheme %? urlEncode m
+
+etom :: Either a b -> Maybe b
+etom = either (const Nothing) Just
+
+-- | Try to parse magnet link from urlencoded string.
+parseMagnet :: String -> Maybe Magnet
+parseMagnet = parseURI >=> etom . fromURI
+
+-- | Render magnet link to urlencoded string
+renderMagnet :: Magnet -> String
+renderMagnet = show . toURI
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
new file mode 100644
index 00000000..ea4e6253
--- /dev/null
+++ b/src/Data/Torrent/Piece.hs
@@ -0,0 +1,203 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Torrent.Piece
+       ( -- * Piece attributes
+         -- ** Piece size
+         PieceSize (..)
+       , defaultBlockSize -- TODO use data-default
+       , optimalPieceCount
+       , defaultPieceSize -- TODO use data-default
+
+         -- ** Piece index
+       , PieceIx
+
+         -- * Piece data
+       , Piece (..)
+       , ppPiece
+
+         -- * Piece control
+       , PieceInfo (..)
+       , ppPieceInfo
+       , pieceLength
+       , pieceHashes
+       , pieceHash
+       , pieceCount
+       , checkPieceLazy
+
+
+         -- * Internal
+       , getPieceInfo
+       , putPieceInfo
+       ) where
+
+import Control.DeepSeq
+import Control.Lens
+import qualified Crypto.Hash.SHA1 as SHA1
+import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson.TH
+import Data.BEncode
+import Data.BEncode.Types
+import Data.Bits
+import Data.Bits.Extras
+import Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
+import Data.Char
+import Data.Int
+import Data.List as L
+import Data.Typeable
+import Text.PrettyPrint
+
+
+class Lint a where
+  lint :: a -> Either String a
+
+type PieceCount = Int -- TODO newtype
+type PieceIx = Int    -- TODO remove
+
+newtype PieceIndex = PieceIndex Int
+
+-- | An int used to denote piece size.
+newtype PieceSize = PieceSize Int
+  deriving (Show, Read, Typeable
+           , Eq, Ord, Enum
+           , Num, Real, Integral
+           , BEncode, ToJSON, FromJSON
+           )
+
+-- | Widely used semi-official block size.
+defaultBlockSize :: Int
+defaultBlockSize = 16 * 1024
+
+maxPieceSize :: Int
+maxPieceSize = 4 * 1024 * 1024
+{-# INLINE maxPieceSize #-}
+
+minPieceSize :: Int
+minPieceSize = defaultBlockSize * 4
+{-# INLINE minPieceSize #-}
+
+-- | NOTE: Have max and min size constrained to wide used
+-- semi-standard values. This bounds should be used to make decision
+-- about piece size for new torrents.
+--
+instance Bounded PieceSize where
+  maxBound = PieceSize maxPieceSize
+  {-# INLINE maxBound #-}
+
+  minBound = PieceSize minPieceSize
+  {-# INLINE minBound #-}
+
+-- | TODO
+optimalPieceCount :: Int
+optimalPieceCount = 1000
+{-# INLINE optimalPieceCount #-}
+
+toPow2 :: Int -> Int
+toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x)
+
+-- | Find the optimal piece size for a given torrent size.
+defaultPieceSize :: Int64 -> Int
+defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc
+  where
+    pc = fromIntegral (x `div` fromIntegral optimalPieceCount)
+
+-- TODO check if pieceLength is power of 2
+-- | Piece payload should be strict or lazy bytestring.
+data Piece a = Piece
+  { -- | Zero-based piece index in torrent. TODO how pieces are indexed?
+    pieceIndex :: {-# UNPACK #-} !PieceIx
+    -- | Payload.
+  , pieceData  :: !a
+  } deriving (Show, Read, Eq, Typeable)
+
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece)
+
+instance NFData (Piece a)
+
+-- | Format piece in human readable form. Payload bytes are omitted.
+ppPiece :: Piece a -> Doc
+ppPiece Piece {..}
+  = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
+
+data PieceInfo = PieceInfo
+  { piPieceLength  :: {-# UNPACK #-} !PieceSize
+    -- ^ Number of bytes in each piece.
+
+  , piPieceHashes  :: !ByteString
+    -- ^ Concatenation of all 20-byte SHA1 hash values.
+  } deriving (Show, Read, Eq, Typeable)
+
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PieceInfo)
+
+-- | Number of bytes in each piece.
+makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
+
+-- | Concatenation of all 20-byte SHA1 hash values.
+makeLensesFor [("piPieceHashes", "pieceHashes")] ''PieceInfo
+
+instance NFData PieceInfo
+
+instance Lint PieceInfo where
+  lint pinfo @ PieceInfo {..}
+    | BS.length piPieceHashes `rem` hashsize == 0
+    , piPieceLength >= 0 = return pinfo
+    |       otherwise    = Left undefined
+
+
+putPieceInfo :: PieceInfo -> BDict -> BDict
+putPieceInfo PieceInfo {..} cont =
+       "piece length" .=! piPieceLength
+    .: "pieces"       .=! piPieceHashes
+    .: cont
+
+getPieceInfo :: Get PieceInfo
+getPieceInfo = do
+    PieceInfo <$>! "piece length"
+              <*>! "pieces"
+
+instance BEncode PieceInfo where
+  toBEncode   = toDict . (`putPieceInfo` endDict)
+  fromBEncode = fromDict getPieceInfo
+
+-- | Format piece info in human readable form. Hashes are omitted.
+ppPieceInfo :: PieceInfo -> Doc
+ppPieceInfo PieceInfo { piPieceLength = PieceSize len } =
+  "PieceInfo" <+> braces ("length" <+> "=" <+> int len)
+
+hashsize :: Int
+hashsize = 20
+{-# INLINE hashsize #-}
+
+slice :: Int -> Int -> ByteString -> ByteString
+slice start len = BS.take len . BS.drop start
+{-# INLINE slice #-}
+
+-- | Extract validation hash by specified piece index.
+pieceHash :: PieceInfo -> PieceIx -> ByteString
+pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize piPieceHashes
+
+-- | Find count of pieces in the torrent. If torrent size is not a
+-- multiple of piece size then the count is rounded up.
+pieceCount :: PieceInfo -> PieceCount
+pieceCount PieceInfo {..} = BS.length piPieceHashes `quot` hashsize
+
+isLastPiece :: PieceInfo -> PieceIx -> Bool
+isLastPiece ci i = pieceCount ci == succ i
+
+class Validation a where
+  validate :: PieceInfo -> Piece a -> Bool
+
+-- | Validate piece with metainfo hash.
+checkPieceLazy :: PieceInfo -> Piece BL.ByteString -> Bool
+checkPieceLazy pinfo @ PieceInfo {..} Piece {..}
+  = (fromIntegral (BL.length pieceData) == piPieceLength
+     || isLastPiece pinfo pieceIndex)
+  && SHA1.hashlazy pieceData == pieceHash pinfo pieceIndex
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs
new file mode 100644
index 00000000..e9a337a1
--- /dev/null
+++ b/src/Data/Torrent/Tree.hs
@@ -0,0 +1,71 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Data.Torrent.Tree
+       ( DirTree (..)
+       , build
+
+       , Data.Torrent.Tree.lookup
+       , lookupDir
+
+       , fileCount
+       , dirCount
+       ) where
+
+import Control.Arrow
+import Data.ByteString as BS
+import Data.ByteString.Char8 as BC
+import Data.Foldable
+import Data.List as L
+import Data.Map  as M
+import Data.Monoid
+
+import Data.Torrent.Layout
+
+
+data DirTree a = Dir  { children :: Map ByteString (DirTree a) }
+               | File { node     :: FileInfo a                 }
+                 deriving Show
+
+build :: LayoutInfo -> DirTree ()
+build SingleFile {liFile = FileInfo {..}} = Dir
+    { children = M.singleton fiName (File fi) }
+  where
+    fi = FileInfo fiLength fiMD5Sum ()
+build MultiFile {..} = Dir $ M.singleton liDirName files
+  where
+    files = Dir $ M.fromList $ L.map mkFileEntry liFiles
+    mkFileEntry FileInfo {..} = (L.head fiName, ent) -- TODO FIXME
+      where
+        ent = File $ FileInfo fiLength fiMD5Sum ()
+
+decompress :: DirTree () -> [FileInfo ()]
+decompress = undefined
+
+lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
+lookup []        t      = Just t
+lookup (p : ps) (Dir m) | Just subTree <- M.lookup (BC.pack p) m
+                        = Data.Torrent.Tree.lookup ps subTree
+lookup _         _      = Nothing
+
+lookupDir :: [FilePath] -> DirTree a -> Maybe [(ByteString, DirTree a)]
+lookupDir ps d
+  | Just subTree <- Data.Torrent.Tree.lookup ps d =
+    case subTree of
+      File _  -> Nothing
+      Dir  es -> Just $ M.toList es
+
+fileCount :: DirTree a -> Sum Int
+fileCount File {..} = Sum 1
+fileCount Dir  {..} = foldMap fileCount children
+
+dirCount :: DirTree a -> Sum Int
+dirCount File {..} = Sum 0
+dirCount Dir  {..} = Sum 1 <> foldMap dirCount children