Refactor Network.BitTorrent.Peer module

5 files changed, 725 insertions, 661 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 #-}
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
new file mode 100644
index 00000000..84b1e1f6
--- /dev/null
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -0,0 +1,119 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   * 'PeerAddr' is used to represent peer location. Currently it's
+-- just peer IP and peer port but this might be changed later.
+--
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# OPTIONS -fno-warn-orphans           #-} -- for PortNumber instances
+module Network.BitTorrent.Core.PeerAddr
+       ( -- * Peer address
+         PeerAddr(..)
+       , getCompactPeerList
+       , peerSockAddr
+       , connectToPeer
+       , ppPeer
+       ) where
+
+import Control.Applicative
+import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson.TH
+import Data.BEncode   as BS
+import Data.Bits
+import Data.Char
+import Data.List      as L
+import Data.Serialize as S
+import Data.Typeable
+import Data.Word
+import Network.Socket
+import Text.PrettyPrint
+
+import Data.Torrent.Client
+import Network.BitTorrent.Core.PeerId
+
+
+deriving instance ToJSON PortNumber
+deriving instance FromJSON PortNumber
+
+instance BEncode PortNumber where
+  toBEncode = toBEncode . fromEnum
+  fromBEncode b = toEnum <$> fromBEncode b
+
+instance Serialize PortNumber where
+  get = fromIntegral <$> getWord16be
+  {-# INLINE get #-}
+  put = putWord16be . fromIntegral
+  {-# INLINE put #-}
+
+-- TODO check semantic of ord and eq instances
+
+-- | Peer address info normally extracted from peer list or peer
+-- compact list encoding.
+data PeerAddr = PeerAddr {
+      peerID   :: Maybe PeerId
+    , peerIP   :: {-# UNPACK #-} !HostAddress
+    , peerPort :: {-# UNPACK #-} !PortNumber
+    } deriving (Show, Eq, Ord, Typeable)
+
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr)
+
+instance BEncode PeerAddr where
+  toBEncode (PeerAddr pid pip pport) = toDict $
+       "peer id" .=? pid
+    .: "ip"      .=!  pip
+    .: "port"    .=!  pport
+    .: endDict
+
+  fromBEncode = fromDict $ do
+    PeerAddr <$>? "peer id"
+             <*>! "ip"
+             <*>! "port"
+
+instance Serialize PeerAddr where
+  put PeerAddr {..} = put peerID >> put peerPort
+  {-# INLINE put #-}
+  get = PeerAddr Nothing <$> get <*> get
+  {-# INLINE get #-}
+
+getCompactPeerList :: S.Get [PeerAddr]
+getCompactPeerList = many get
+
+-- TODO make platform independent, clarify htonl
+
+-- | Convert peer info from tracker response to socket address.  Used
+--   for establish connection between peers.
+--
+peerSockAddr :: PeerAddr -> SockAddr
+peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
+  where
+    htonl :: Word32 -> Word32
+    htonl d =
+       ((d .&. 0xff) `shiftL` 24) .|.
+       (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
+       (((d `shiftR` 16) .&. 0xff) `shiftL` 8)  .|.
+       ((d `shiftR` 24) .&. 0xff)
+
+    g :: PortNumber -> PortNumber
+    g = id
+
+-- | Tries to connect to peer using reasonable default parameters.
+connectToPeer :: PeerAddr -> IO Socket
+connectToPeer p = do
+  sock <- socket AF_INET Stream Network.Socket.defaultProtocol
+  connect sock (peerSockAddr p)
+  return sock
+
+-- | Pretty print peer address in human readable form.
+ppPeer :: PeerAddr -> Doc
+ppPeer p @ PeerAddr {..} = case peerID of
+    Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
+    Nothing  -> paddr
+  where
+    paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
new file mode 100644
index 00000000..a32aa990
--- /dev/null
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -0,0 +1,278 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--  'PeerID' represent self assigned peer identificator. Ideally each
+--  host in the network should have unique peer id to avoid
+--  collisions, therefore for peer ID generation we use good entropy
+--  source. (FIX not really) Peer ID is sent in /tracker request/,
+--  sent and received in /peer handshakes/ and used in /distributed
+--  hash table/ queries.
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Network.BitTorrent.Core.PeerId
+       ( -- * PeerId
+         PeerId (getPeerId)
+       , ppPeerId
+
+         -- * Generation
+       , genPeerId
+       , timestamp
+       , entropy
+
+         -- * Encoding
+       , azureusStyle
+       , shadowStyle
+
+         -- * Decoding
+       , clientInfo
+
+         -- ** Extra
+       , byteStringPadded
+       , defaultClientId
+       , defaultVersionNumber
+       ) where
+
+import Control.Applicative
+import Data.Aeson
+import Data.BEncode as BE
+import Data.ByteString as BS
+import Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Builder as BS
+import Data.Default
+import Data.Foldable    (foldMap)
+import Data.List as L
+import Data.Maybe       (fromMaybe)
+import Data.Monoid
+import Data.Serialize as S
+import Data.Time.Clock  (getCurrentTime)
+import Data.Time.Format (formatTime)
+import Data.URLEncoded
+import Data.Version     (Version(Version), versionBranch)
+import System.Entropy   (getEntropy)
+import System.Locale    (defaultTimeLocale)
+import Text.PrettyPrint hiding ((<>))
+import Text.Read        (readMaybe)
+import Paths_bittorrent (version)
+
+import Data.Torrent.Client
+
+
+-- | Peer identifier is exactly 20 bytes long bytestring.
+newtype PeerId = PeerId { getPeerId :: ByteString }
+                 deriving (Show, Eq, Ord, BEncode, ToJSON, FromJSON)
+
+instance Serialize PeerId where
+  put = putByteString . getPeerId
+  get = PeerId <$> getBytes 20
+
+instance URLShow PeerId where
+  urlShow = BC.unpack . getPeerId
+
+-- | Format peer id in human readable form.
+ppPeerId :: PeerId -> Doc
+ppPeerId = text . BC.unpack . getPeerId
+
+{-----------------------------------------------------------------------
+--  Encoding
+-----------------------------------------------------------------------}
+
+-- | Pad bytestring so it's becomes exactly request length. Conversion
+-- is done like so:
+--
+--     * length < size: Complete bytestring by given charaters.
+--
+--     * length = size: Output bytestring as is.
+--
+--     * length > size: Drop last (length - size) charaters from a
+--     given bytestring.
+--
+byteStringPadded :: ByteString -- ^ bytestring to be padded.
+                 -> Int        -- ^ size of result builder.
+                 -> Char       -- ^ character used for padding.
+                 -> BS.Builder
+byteStringPadded bs s c =
+      BS.byteString (BS.take s bs) <>
+      BS.byteString (BC.replicate padLen c)
+  where
+    padLen = s - min (BS.length bs) s
+
+-- | Azureus-style encoding have the following layout:
+--
+--     * 1  byte : '-'
+--
+--     * 2  bytes: client id
+--
+--     * 4  bytes: version number
+--
+--     * 1  byte : '-'
+--
+--     * 12 bytes: random number
+--
+azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
+             -> ByteString -- ^ Version number, padded with 'X'.
+             -> ByteString -- ^ Random number, padded with '0'.
+             -> PeerId     -- ^ Azureus-style encoded peer ID.
+azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
+    BS.char8 '-' <>
+      byteStringPadded cid 2  'H' <>
+      byteStringPadded ver 4  'X' <>
+    BS.char8 '-' <>
+      byteStringPadded rnd 12 '0'
+
+-- | Shadow-style encoding have the following layout:
+--
+--     * 1 byte   : client id.
+--
+--     * 0-4 bytes: version number. If less than 4 then padded with
+--     '-' char.
+--
+--     * 15 bytes : random number. If length is less than 15 then
+--     padded with '0' char.
+--
+shadowStyle :: Char       -- ^ Client ID.
+            -> ByteString -- ^ Version number.
+            -> ByteString -- ^ Random number.
+            -> PeerId     -- ^ Shadow style encoded peer ID.
+shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
+    BS.char8 cid <>
+      byteStringPadded ver 4  '-' <>
+      byteStringPadded rnd 15 '0'
+
+
+-- | "HS" - 2 bytes long client identifier.
+defaultClientId :: ByteString
+defaultClientId = "HS"
+
+-- | Gives exactly 4 bytes long version number for any version of the
+-- package.  Version is taken from .cabal.
+defaultVersionNumber :: ByteString
+defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
+                         versionBranch version
+
+{-----------------------------------------------------------------------
+--  Generation
+-----------------------------------------------------------------------}
+
+-- | Gives 15 characters long decimal timestamp such that:
+--
+--     * 6 bytes   : first 6 characters from picoseconds obtained with %q.
+--
+--     * 1 bytes   : character '.' for readability.
+--
+--     * 9..* bytes: number of whole seconds since the Unix epoch
+--     (!)REVERSED.
+--
+--   Can be used both with shadow and azureus style encoding. This
+--   format is used to make the ID's readable(for debugging) and more
+--   or less random.
+--
+timestamp :: IO ByteString
+timestamp = (BC.pack . format) <$> getCurrentTime
+  where
+    format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
+               L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))
+
+-- | Gives 15 character long random bytestring. This is more robust
+-- method for generation of random part of peer ID than timestamp.
+entropy :: IO ByteString
+entropy = getEntropy 15
+
+-- NOTE: entropy generates incorrrect peer id
+
+-- |  Here we use Azureus-style encoding with the following args:
+--
+--      * 'HS' for the client id.
+--
+--      * Version of the package for the version number
+--
+--      * UTC time day ++ day time for the random number.
+--
+genPeerId :: IO PeerId
+genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
+
+{-----------------------------------------------------------------------
+--  Decoding
+-----------------------------------------------------------------------}
+
+parseImpl :: ByteString -> ClientImpl
+parseImpl = f . BC.unpack
+ where
+  f "AG" = IAres
+  f "A~" = IAres
+  f "AR" = IArctic
+  f "AV" = IAvicora
+  f "AX" = IBitPump
+  f "AZ" = IAzureus
+  f "BB" = IBitBuddy
+  f "BC" = IBitComet
+  f "BF" = IBitflu
+  f "BG" = IBTG
+  f "BR" = IBitRocket
+  f "BS" = IBTSlave
+  f "BX" = IBittorrentX
+  f "CD" = IEnhancedCTorrent
+  f "CT" = ICTorrent
+  f "DE" = IDelugeTorrent
+  f "DP" = IPropagateDataClient
+  f "EB" = IEBit
+  f "ES" = IElectricSheep
+  f "FT" = IFoxTorrent
+  f "GS" = IGSTorrent
+  f "HL" = IHalite
+  f "HS" = IlibHSbittorrent
+  f "HN" = IHydranode
+  f "KG" = IKGet
+  f "KT" = IKTorrent
+  f "LH" = ILH_ABC
+  f "LP" = ILphant
+  f "LT" = ILibtorrent
+  f "lt" = ILibTorrent
+  f "LW" = ILimeWire
+  f "MO" = IMonoTorrent
+  f "MP" = IMooPolice
+  f "MR" = IMiro
+  f "MT" = IMoonlightTorrent
+  f "NX" = INetTransport
+  f "PD" = IPando
+  f "qB" = IqBittorrent
+  f "QD" = IQQDownload
+  f "QT" = IQt4TorrentExample
+  f "RT" = IRetriever
+  f "S~" = IShareaza
+  f "SB" = ISwiftbit
+  f "SS" = ISwarmScope
+  f "ST" = ISymTorrent
+  f "st" = Isharktorrent
+  f "SZ" = IShareaza
+  f "TN" = ITorrentDotNET
+  f "TR" = ITransmission
+  f "TS" = ITorrentstorm
+  f "TT" = ITuoTu
+  f "UL" = IuLeecher
+  f "UT" = IuTorrent
+  f "VG" = IVagaa
+  f "WT" = IBitLet
+  f "WY" = IFireTorrent
+  f "XL" = IXunlei
+  f "XT" = IXanTorrent
+  f "XX" = IXtorrent
+  f "ZT" = IZipTorrent
+  f _    = IUnknown
+
+-- | Tries to extract meaningful information from peer ID bytes. If
+-- peer id uses unknown coding style then client info returned is
+-- 'def'.
+--
+clientInfo :: PeerId -> ClientInfo
+clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
+  where -- TODO other styles
+    getCI = getWord8 >> ClientInfo <$> getClientImpl <*> getClientVersion
+    getClientImpl    = parseImpl   <$> getByteString 2
+    getClientVersion = mkVer       <$> getByteString 4
+      where
+        mkVer bs = ClientVersion $ Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
deleted file mode 100644
index f2148eda..00000000
--- a/src/Network/BitTorrent/Peer.hs
+++ /dev/null
@@ -1,661 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  non-portable
---
---   This modules provides three datatypes related to a peer as a host:
---
---   * 'PeerID' represent self assigned peer identificator. Ideally
---     each host in the network should have unique peer id to avoid
---     collisions, therefor for peer ID generation we use good entropy
---     source. (FIX not really)  Peer ID is sent in /tracker request/,
---     sent and received in /peer handshakes/ and used in /distributed
---     hash table/ queries.
---
---   * 'PeerAddr' is used to represent peer location. Currently it's
---   just peer IP and peer port but this might be changed later.
---
---   * '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'!
---
-{-# LANGUAGE ViewPatterns               #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# OPTIONS  -fno-warn-orphans          #-}
-module Network.BitTorrent.Peer
-       ( -- * Peer identificators
-         PeerId (getPeerId), ppPeerId
-
-         -- ** Encoding styles
-       , azureusStyle, shadowStyle
-
-         -- ** Defaults
-       , defaultClientId, defaultVersionNumber
-
-         -- ** Generation
-       , genPeerId
-       , timestamp, entropy
-
-         -- ** Extra
-       , byteStringPadded
-
-         -- * Peer address
-       , PeerAddr(..)
-       , getCompactPeerList
-       , peerSockAddr
-       , connectToPeer
-       , ppPeer
-
-         -- * Peer progress
-       , Progress (..)
-       , left
-       , uploaded
-       , downloaded
-
-       , startProgress
-
-       , downloadedProgress
-       , enqueuedProgress
-       , uploadedProgress
-       , dequeuedProgress
-
-         -- * Client version detection
-         -- ** Info
-       , ClientInfo(..), clientInfo, ppClientInfo, unknownClient
-
-         -- ** Version
-       , ClientVersion, ppClientVersion
-
-         -- ** Implementation
-       , ClientImpl(..), ppClientImpl
-
-       ) where
-
-
-import Control.Applicative
-import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
-import Data.BEncode
-import Data.Bits
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Builder as B
-import Data.Char
-import Data.List as L
-import Data.Word
-import Data.Foldable    (foldMap)
-import Data.Monoid      ((<>))
-import Data.Serialize
-import Data.URLEncoded
-import Data.Version     (Version(Version), versionBranch)
-import Data.Time.Clock  (getCurrentTime)
-import Data.Time.Format (formatTime)
-import Text.PrettyPrint (text, Doc, (<+>))
-import System.Locale    (defaultTimeLocale)
-import System.Entropy   (getEntropy)
-import Network hiding (accept)
-import Network.Socket
-
-
--- TODO we have linker error here, so manually hardcoded version for a
--- while.
-
--- import Paths_network_bittorrent (version)
-
-version :: Version
-version = Version [0, 10, 0, 0] []
-
-{-----------------------------------------------------------------------
-    Peer identification
------------------------------------------------------------------------}
-
--- | Peer identifier is exactly 20 bytes long bytestring.
-newtype PeerId = PeerId { getPeerId :: ByteString }
-                 deriving (Show, Eq, Ord, BEncodable, ToJSON, FromJSON)
-
-instance Serialize PeerId where
-  put = putByteString . getPeerId
-  get = PeerId <$> getBytes 20
-
-instance URLShow PeerId where
-  urlShow = BC.unpack . getPeerId
-
--- | Format peer id in human readable form.
-ppPeerId :: PeerId -> Doc
-ppPeerId = text . BC.unpack . getPeerId
-
-
--- | Azureus-style encoding have the following layout:
---
---     * 1  byte : '-'
---
---     * 2  bytes: client id
---
---     * 4  bytes: version number
---
---     * 1  byte : '-'
---
---     * 12 bytes: random number
---
-azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
-             -> ByteString -- ^ Version number, padded with 'X'.
-             -> ByteString -- ^ Random number, padded with '0'.
-             -> PeerId     -- ^ Azureus-style encoded peer ID.
-azureusStyle cid ver rnd = PeerId $ BL.toStrict $ B.toLazyByteString $
-    B.char8 '-' <>
-      byteStringPadded cid 2  'H' <>
-      byteStringPadded ver 4  'X' <>
-    B.char8 '-' <>
-      byteStringPadded rnd 12 '0'
-
--- | Shadow-style encoding have the following layout:
---
---     * 1 byte   : client id.
---
---     * 0-4 bytes: version number. If less than 4 then padded with
---     '-' char.
---
---     * 15 bytes : random number. If length is less than 15 then
---     padded with '0' char.
---
-shadowStyle :: Char       -- ^ Client ID.
-            -> ByteString -- ^ Version number.
-            -> ByteString -- ^ Random number.
-            -> PeerId     -- ^ Shadow style encoded peer ID.
-shadowStyle cid ver rnd = PeerId $ BL.toStrict $ B.toLazyByteString $
-    B.char8 cid <>
-      byteStringPadded ver 4  '-' <>
-      byteStringPadded rnd 15 '0'
-
-
--- | "HS" - 2 bytes long client identifier.
-defaultClientId :: ByteString
-defaultClientId = "HS"
-
--- | Gives exactly 4 bytes long version number for any version of the
--- package.  Version is taken from .cabal.
-defaultVersionNumber :: ByteString
-defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $
-                         versionBranch version
-
--- | Gives 15 characters long decimal timestamp such that:
---
---     * 6 bytes   : first 6 characters from picoseconds obtained with %q.
---
---     * 1 bytes   : character '.' for readability.
---
---     * 9..* bytes: number of whole seconds since the Unix epoch
---     (!)REVERSED.
---
---   Can be used both with shadow and azureus style encoding. This
---   format is used to make the ID's readable(for debugging) and more
---   or less random.
---
-timestamp :: IO ByteString
-timestamp = (BC.pack . format) <$> getCurrentTime
-  where
-    format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
-               take 9 (reverse (formatTime defaultTimeLocale "%s" t))
-
--- | Gives 15 character long random bytestring. This is more robust
--- method for generation of random part of peer ID than timestamp.
-entropy :: IO ByteString
-entropy = getEntropy 15
-
--- NOTE: entropy generates incorrrect peer id
-
--- |  Here we use Azureus-style encoding with the following args:
---
---      * 'HS' for the client id.
---
---      * Version of the package for the version number
---
---      * UTC time day ++ day time for the random number.
---
-genPeerId :: IO PeerId
-genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
-
--- | Pad bytestring so it's becomes exactly request length. Conversion
--- is done like so:
---
---     * length < size: Complete bytestring by given charaters.
---
---     * length = size: Output bytestring as is.
---
---     * length > size: Drop last (length - size) charaters from a
---     given bytestring.
---
-byteStringPadded :: ByteString -- ^ bytestring to be padded.
-                 -> Int        -- ^ size of result builder.
-                 -> Char       -- ^ character used for padding.
-                 -> B.Builder
-byteStringPadded bs s c =
-      B.byteString (B.take s bs) <>
-      B.byteString (BC.replicate padLen c)
-  where
-    padLen = s - min (B.length bs) s
-
-
-{-----------------------------------------------------------------------
-    Client detection
------------------------------------------------------------------------}
-
--- | 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)
-
-parseImpl :: ByteString -> ClientImpl
-parseImpl = f . BC.unpack
- where
-  f "AG" = IAres
-  f "A~" = IAres
-  f "AR" = IArctic
-  f "AV" = IAvicora
-  f "AX" = IBitPump
-  f "AZ" = IAzureus
-  f "BB" = IBitBuddy
-  f "BC" = IBitComet
-  f "BF" = IBitflu
-  f "BG" = IBTG
-  f "BR" = IBitRocket
-  f "BS" = IBTSlave
-  f "BX" = IBittorrentX
-  f "CD" = IEnhancedCTorrent
-  f "CT" = ICTorrent
-  f "DE" = IDelugeTorrent
-  f "DP" = IPropagateDataClient
-  f "EB" = IEBit
-  f "ES" = IElectricSheep
-  f "FT" = IFoxTorrent
-  f "GS" = IGSTorrent
-  f "HL" = IHalite
-  f "HS" = IlibHSbittorrent
-  f "HN" = IHydranode
-  f "KG" = IKGet
-  f "KT" = IKTorrent
-  f "LH" = ILH_ABC
-  f "LP" = ILphant
-  f "LT" = ILibtorrent
-  f "lt" = ILibTorrent
-  f "LW" = ILimeWire
-  f "MO" = IMonoTorrent
-  f "MP" = IMooPolice
-  f "MR" = IMiro
-  f "MT" = IMoonlightTorrent
-  f "NX" = INetTransport
-  f "PD" = IPando
-  f "qB" = IqBittorrent
-  f "QD" = IQQDownload
-  f "QT" = IQt4TorrentExample
-  f "RT" = IRetriever
-  f "S~" = IShareaza
-  f "SB" = ISwiftbit
-  f "SS" = ISwarmScope
-  f "ST" = ISymTorrent
-  f "st" = Isharktorrent
-  f "SZ" = IShareaza
-  f "TN" = ITorrentDotNET
-  f "TR" = ITransmission
-  f "TS" = ITorrentstorm
-  f "TT" = ITuoTu
-  f "UL" = IuLeecher
-  f "UT" = IuTorrent
-  f "VG" = IVagaa
-  f "WT" = IBitLet
-  f "WY" = IFireTorrent
-  f "XL" = IXunlei
-  f "XT" = IXanTorrent
-  f "XX" = IXtorrent
-  f "ZT" = IZipTorrent
-  f _    = IUnknown
-
--- | Format client implementation info in human readable form.
-ppClientImpl :: ClientImpl -> Doc
-ppClientImpl = text . tail . show
-
--- | Used to represent not recognized implementation
-unknownImpl :: ClientImpl
-unknownImpl = IUnknown
-
--- TODO use Data.Version
-
--- | Raw version of client, normally extracted from peer id.
-type ClientVersion = ByteString
-
--- | Format client implementation version in human readable form.
-ppClientVersion :: ClientVersion -> Doc
-ppClientVersion = text . BC.unpack
-
-unknownVersion :: ClientVersion
-unknownVersion = "0000"
-
-
--- | All useful infomation that can be obtained from a peer
--- identifier.
-data ClientInfo = ClientInfo {
-    ciImpl    :: ClientImpl
-  , ciVersion :: ClientVersion
-  } deriving (Show, Eq, Ord)
-
--- | Format client implementation in human readable form.
-ppClientInfo :: ClientInfo -> Doc
-ppClientInfo ClientInfo {..} =
-  ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
-
-
--- | Unrecognized client implementation.
-unknownClient :: ClientInfo
-unknownClient = ClientInfo unknownImpl unknownVersion
-
--- | Tries to extract meaningful information from peer ID bytes. If
--- peer id uses unknown coding style then client info returned is
--- 'unknownClient'.
---
-clientInfo :: PeerId -> ClientInfo
-clientInfo pid = either (const unknownClient) id $
-                     runGet getCI (getPeerId pid)
-  where -- TODO other styles
-    getCI = do
-      _ <- getWord8
-      ClientInfo <$> (parseImpl <$> getByteString 2) <*> getByteString 4
-
-
-{-
--- 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")
- ]
--}
-
-{-----------------------------------------------------------------------
-    Peer address
------------------------------------------------------------------------}
-deriving instance ToJSON PortNumber
-deriving instance FromJSON PortNumber
-
-instance BEncodable PortNumber where
-  toBEncode = toBEncode . fromEnum
-  fromBEncode b = toEnum <$> fromBEncode b
-
-instance Serialize PortNumber where
-  get = fromIntegral <$> getWord16be
-  {-# INLINE get #-}
-  put = putWord16be . fromIntegral
-  {-# INLINE put #-}
-
--- TODO check semantic of ord and eq instances
-
-
--- | Peer address info normally extracted from peer list or peer
--- compact list encoding.
-data PeerAddr = PeerAddr {
-      peerID   :: Maybe PeerId
-    , peerIP   :: {-# UNPACK #-} !HostAddress
-    , peerPort :: {-# UNPACK #-} !PortNumber
-    } deriving (Show, Eq, Ord)
-
-$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr)
-
-instance BEncodable PeerAddr where
-  toBEncode (PeerAddr pid pip pport) = fromAssocs
-    [ "peer id" -->? pid
-    , "ip"      -->  pip
-    , "port"    -->  pport
-    ]
-
-  fromBEncode (BDict d) =
-    PeerAddr <$> d >--? "peer id"
-             <*> d >--  "ip"
-             <*> d >--  "port"
-
-  fromBEncode _ = decodingError "PeerAddr"
-
-instance Serialize PeerAddr where
-  put PeerAddr {..} = put peerID >> put peerPort
-  {-# INLINE put #-}
-  get = PeerAddr Nothing <$> get <*> get
-  {-# INLINE get #-}
-
-getCompactPeerList :: Get [PeerAddr]
-getCompactPeerList = many get
-
--- TODO make platform independent, clarify htonl
-
--- | Convert peer info from tracker response to socket address.  Used
---   for establish connection between peers.
---
-peerSockAddr :: PeerAddr -> SockAddr
-peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
-  where
-    htonl :: Word32 -> Word32
-    htonl d =
-       ((d .&. 0xff) `shiftL` 24) .|.
-       (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
-       (((d `shiftR` 16) .&. 0xff) `shiftL` 8)  .|.
-       ((d `shiftR` 24) .&. 0xff)
-
-    g :: PortNumber -> PortNumber
-    g = id
-
--- | Tries to connect to peer using reasonable default parameters.
-connectToPeer :: PeerAddr -> IO Socket
-connectToPeer p = do
-  sock <- socket AF_INET Stream Network.Socket.defaultProtocol
-  connect sock (peerSockAddr p)
-  return sock
-
--- | Pretty print peer address in human readable form.
-ppPeer :: PeerAddr -> Doc
-ppPeer p @ PeerAddr {..} = case peerID of
-    Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
-    Nothing  -> paddr
-  where
-    paddr = text (show (peerSockAddr p))
-
-{-----------------------------------------------------------------------
-  Progress
------------------------------------------------------------------------}
-
--- 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)
-
--- | 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
-
--- | 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 #-}