Merge bittorrent package with torrent-content

1 files changed, 273 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