Refactor Network.BitTorrent.Peer module

2 files changed, 328 insertions, 0 deletions

diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
new file mode 100644
index 00000000..b6649e04
--- /dev/null
+++ b/src/Data/Torrent/Client.hs
@@ -0,0 +1,233 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   'ClientInfo' is used to identify the client implementation and
+--   version which also contained in 'Peer'. For exsample first 6
+--   bytes of peer id of this this library are @-HS0100-@ while for
+--   mainline we have @M4-3-6--@.  We could extract this info and
+--   print in human frienly form: this is useful for debugging and
+--   logging. For more information see:
+--   <http://bittorrent.org/beps/bep_0020.html> NOTE: Do _not_ use
+--   this information to control client capabilities (such as
+--   supported enchancements), this should be done using
+--   'Network.BitTorrent.Extension'!
+--
+module Data.Torrent.Client
+       ( ClientImpl (..)
+       , ppClientImpl
+
+       , ClientVersion (..)
+       , ppClientVersion
+
+       , ClientInfo (..)
+       , ppClientInfo
+       , libClientInfo
+       ) where
+
+import Control.Applicative
+import Data.ByteString as BS
+import Data.ByteString.Char8 as BC
+import Data.Default
+import Data.List as L
+import Data.Monoid
+import Data.Text as T
+import Data.Version
+import Text.PrettyPrint hiding ((<>))
+import Paths_bittorrent (version)
+
+
+-- | All known client versions.
+data ClientImpl =
+   IUnknown
+ | IAres
+ | IArctic
+ | IAvicora
+ | IBitPump
+ | IAzureus
+ | IBitBuddy
+ | IBitComet
+ | IBitflu
+ | IBTG
+ | IBitRocket
+ | IBTSlave
+ | IBittorrentX
+ | IEnhancedCTorrent
+ | ICTorrent
+ | IDelugeTorrent
+ | IPropagateDataClient
+ | IEBit
+ | IElectricSheep
+ | IFoxTorrent
+ | IGSTorrent
+ | IHalite
+ | IlibHSbittorrent
+ | IHydranode
+ | IKGet
+ | IKTorrent
+ | ILH_ABC
+ | ILphant
+ | ILibtorrent
+ | ILibTorrent
+ | ILimeWire
+ | IMonoTorrent
+ | IMooPolice
+ | IMiro
+ | IMoonlightTorrent
+ | INetTransport
+ | IPando
+ | IqBittorrent
+ | IQQDownload
+ | IQt4TorrentExample
+ | IRetriever
+ | IShareaza
+ | ISwiftbit
+ | ISwarmScope
+ | ISymTorrent
+ | Isharktorrent
+ | ITorrentDotNET
+ | ITransmission
+ | ITorrentstorm
+ | ITuoTu
+ | IuLeecher
+ | IuTorrent
+ | IVagaa
+ | IBitLet
+ | IFireTorrent
+ | IXunlei
+ | IXanTorrent
+ | IXtorrent
+ | IZipTorrent
+   deriving (Show, Eq, Ord, Enum, Bounded)
+
+-- | Used to represent not recognized implementation
+instance Default ClientImpl where
+  def = IUnknown
+
+-- | Format client implementation info in human readable form.
+ppClientImpl :: ClientImpl -> Doc
+ppClientImpl = text . L.tail . show
+
+-- | Raw version of client, normally extracted from peer id.
+newtype ClientVersion = ClientVersion { getClientVersion :: Version }
+  deriving (Show, Eq, Ord)
+
+instance Default ClientVersion where
+  def = ClientVersion $ Version [0] []
+
+-- | Format client implementation version in human readable form.
+ppClientVersion :: ClientVersion -> Doc
+ppClientVersion = text . showVersion . getClientVersion
+
+-- | All useful infomation that can be obtained from a peer
+-- identifier.
+data ClientInfo = ClientInfo {
+    ciImpl    :: ClientImpl
+  , ciVersion :: ClientVersion
+  } deriving (Show, Eq, Ord)
+
+-- | Unrecognized client implementation.
+instance Default ClientInfo where
+  def = ClientInfo def def
+
+-- | Format client implementation in human readable form.
+ppClientInfo :: ClientInfo -> Doc
+ppClientInfo ClientInfo {..} =
+  ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
+
+libClientInfo :: ClientInfo
+libClientInfo = ClientInfo IlibHSbittorrent (ClientVersion version)
+
+{-----------------------------------------------------------------------
+--  For torrent file
+-----------------------------------------------------------------------}
+
+renderImpl :: ClientImpl -> Text
+renderImpl = T.pack . L.tail . show
+
+renderVersion :: ClientVersion -> Text
+renderVersion = undefined
+
+renderClientInfo :: ClientInfo -> Text
+renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
+
+parseClientInfo :: Text -> ClientImpl
+parseClientInfo t = undefined
+
+{-
+-- code used for generation; remove it later on
+
+mkEnumTyDef :: NM -> String
+mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
+
+mkPars :: NM -> String
+mkPars = unlines . map (\(code, impl) -> "  f \"" ++ code ++ "\" = " ++ "I" ++ impl)
+
+type NM = [(String, String)]
+nameMap :: NM
+nameMap =
+ [ ("AG", "Ares")
+ , ("A~", "Ares")
+ , ("AR", "Arctic")
+ , ("AV", "Avicora")
+ , ("AX", "BitPump")
+ , ("AZ", "Azureus")
+ , ("BB", "BitBuddy")
+ , ("BC", "BitComet")
+ , ("BF", "Bitflu")
+ , ("BG", "BTG")
+ , ("BR", "BitRocket")
+ , ("BS", "BTSlave")
+ , ("BX", "BittorrentX")
+ , ("CD", "EnhancedCTorrent")
+ , ("CT", "CTorrent")
+ , ("DE", "DelugeTorrent")
+ , ("DP", "PropagateDataClient")
+ , ("EB", "EBit")
+ , ("ES", "ElectricSheep")
+ , ("FT", "FoxTorrent")
+ , ("GS", "GSTorrent")
+ , ("HL", "Halite")
+ , ("HS", "libHSnetwork_bittorrent")
+ , ("HN", "Hydranode")
+ , ("KG", "KGet")
+ , ("KT", "KTorrent")
+ , ("LH", "LH_ABC")
+ , ("LP", "Lphant")
+ , ("LT", "Libtorrent")
+ , ("lt", "LibTorrent")
+ , ("LW", "LimeWire")
+ , ("MO", "MonoTorrent")
+ , ("MP", "MooPolice")
+ , ("MR", "Miro")
+ , ("MT", "MoonlightTorrent")
+ , ("NX", "NetTransport")
+ , ("PD", "Pando")
+ , ("qB", "qBittorrent")
+ , ("QD", "QQDownload")
+ , ("QT", "Qt4TorrentExample")
+ , ("RT", "Retriever")
+ , ("S~", "Shareaza")
+ , ("SB", "Swiftbit")
+ , ("SS", "SwarmScope")
+ , ("ST", "SymTorrent")
+ , ("st", "sharktorrent")
+ , ("SZ", "Shareaza")
+ , ("TN", "TorrentDotNET")
+ , ("TR", "Transmission")
+ , ("TS", "Torrentstorm")
+ , ("TT", "TuoTu")
+ , ("UL", "uLeecher")
+ , ("UT", "uTorrent")
+ , ("VG", "Vagaa")
+ , ("WT", "BitLet")
+ , ("WY", "FireTorrent")
+ , ("XL", "Xunlei")
+ , ("XT", "XanTorrent")
+ , ("XX", "Xtorrent")
+ , ("ZT", "ZipTorrent")
+ ]
+-}
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
new file mode 100644
index 00000000..c1515cf0
--- /dev/null
+++ b/src/Data/Torrent/Progress.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ViewPatterns    #-}
+module Data.Torrent.Progress
+       ( -- * Peer progress
+         Progress (..)
+       , left
+       , uploaded
+       , downloaded
+
+       , startProgress
+
+       , downloadedProgress
+       , enqueuedProgress
+       , uploadedProgress
+       , dequeuedProgress
+
+       ) where
+
+import Control.Applicative
+import Control.Lens
+import Data.Aeson.TH
+import Data.List as L
+import Data.Default
+import Data.Serialize as S
+
+
+-- TODO: Use Word64?
+-- TODO: Use atomic bits?
+
+-- | 'Progress' contains upload/download/left stats about
+--   current client state and used to notify the tracker.
+--
+-- Progress data is considered as dynamic within one client
+-- session. This data also should be shared across client application
+-- sessions (e.g. files), otherwise use 'startProgress' to get initial
+-- 'Progress'.
+--
+data Progress = Progress
+  { _downloaded :: !Integer -- ^ Total amount of bytes downloaded;
+  , _left       :: !Integer -- ^ Total amount of bytes left;
+  , _uploaded   :: !Integer -- ^ Total amount of bytes uploaded.
+  } deriving (Show, Read, Eq)
+
+$(makeLenses ''Progress)
+$(deriveJSON L.tail ''Progress)
+
+instance Serialize Progress where
+  put Progress {..} = do
+    putWord64be $ fromIntegral _downloaded
+    putWord64be $ fromIntegral _left
+    putWord64be $ fromIntegral _uploaded
+
+  get = Progress
+    <$> (fromIntegral <$> getWord64be)
+    <*> (fromIntegral <$> getWord64be)
+    <*> (fromIntegral <$> getWord64be)
+
+instance Default Progress where
+  def = Progress 0 0 0
+  {-# INLINE def #-}
+
+-- TODO Monoid instance
+
+-- | Initial progress is used when there are no session before.
+--
+-- Please note that tracker might penalize client some way if the do
+-- not accumulate progress. If possible and save 'Progress' between
+-- client sessions to avoid that.
+--
+startProgress :: Integer -> Progress
+startProgress = Progress 0 0
+{-# INLINE startProgress #-}
+
+-- | Used when the client download some data from /any/ peer.
+downloadedProgress :: Int -> Progress -> Progress
+downloadedProgress (fromIntegral -> amount)
+                 = (left         -~ amount)
+                 . (downloaded   +~ amount)
+{-# INLINE downloadedProgress #-}
+
+-- | Used when the client upload some data to /any/ peer.
+uploadedProgress :: Int -> Progress -> Progress
+uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
+{-# INLINE uploadedProgress #-}
+
+-- | Used when leecher join client session.
+enqueuedProgress :: Integer -> Progress -> Progress
+enqueuedProgress amount = left +~ amount
+{-# INLINE enqueuedProgress #-}
+
+-- | Used when leecher leave client session.
+--   (e.g. user deletes not completed torrent)
+dequeuedProgress :: Integer -> Progress -> Progress
+dequeuedProgress amount = left -~ amount
+{-# INLINE dequeuedProgress #-}