1 files changed, 0 insertions, 364 deletions

diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
deleted file mode 100644
index a180ff30..00000000
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ /dev/null
@@ -1,364 +0,0 @@
--- |
---   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. Peer ID is sent in /tracker request/, sent and received in
---  /peer handshakes/ and used in DHT queries.
---
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-module Network.BitTorrent.Core.PeerId
-       ( -- * PeerId
-         PeerId
-
-         -- * Generation
-       , genPeerId
-       , timestamp
-       , entropy
-
-         -- * Encoding
-       , azureusStyle
-       , shadowStyle
-       , defaultClientId
-       , defaultVersionNumber
-
-         -- * Decoding
-       , fingerprint
-       ) where
-
-import Control.Applicative
-import Data.BEncode as BE
-import Data.ByteString as BS
-import Data.ByteString.Internal 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.Convertible
-import Data.Default
-import Data.Foldable    (foldMap)
-import Data.List as L
-import Data.List.Split as L
-import Data.Maybe       (fromMaybe, catMaybes)
-import Data.Monoid
-import Data.Hashable
-import Data.Serialize as S
-import Data.String
-import Data.Time.Clock  (getCurrentTime)
-import Data.Time.Format (formatTime)
-import Data.Typeable
-import Data.Version     (Version(Version), versionBranch)
-import Network.HTTP.Types.QueryLike
-import System.Entropy   (getEntropy)
-import System.Locale    (defaultTimeLocale)
-import Text.PrettyPrint hiding ((<>))
-import Text.PrettyPrint.Class
-import Text.Read        (readMaybe)
-
-import Network.BitTorrent.Core.Fingerprint
-
--- TODO use unpacked Word160 form (length is known statically)
-
--- | Peer identifier is exactly 20 bytes long bytestring.
-newtype PeerId = PeerId { getPeerId :: ByteString }
-  deriving (Show, Eq, Ord, BEncode, Typeable)
-
-peerIdLen :: Int
-peerIdLen = 20
-
--- | For testing purposes only.
-instance Default PeerId where
-  def = azureusStyle defaultClientId defaultVersionNumber ""
-
-instance Hashable PeerId where
-  hashWithSalt = hashUsing getPeerId
-  {-# INLINE hashWithSalt #-}
-
-instance Serialize PeerId where
-  put = putByteString . getPeerId
-  get = PeerId <$> getBytes peerIdLen
-
-instance QueryValueLike PeerId where
-  toQueryValue (PeerId pid) = Just pid
-  {-# INLINE toQueryValue #-}
-
-instance IsString PeerId where
-  fromString str
-      | BS.length bs == peerIdLen = PeerId bs
-      | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str
-    where
-      bs = fromString str
-
-instance Pretty PeerId where
-  pretty = text . BC.unpack . getPeerId
-
-instance Convertible BS.ByteString PeerId where
-  safeConvert bs
-    | BS.length bs == peerIdLen = pure (PeerId bs)
-    |          otherwise        = convError "invalid length" bs
-
-{-----------------------------------------------------------------------
---  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 file.
-defaultVersionNumber :: ByteString
-defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
-                         versionBranch $ ciVersion libFingerprint
-
-{-----------------------------------------------------------------------
---  Generation
------------------------------------------------------------------------}
-
--- | Gives 15 characters long decimal timestamp such that:
---
---     * 6 bytes   : first 6 characters from picoseconds obtained with %q.
---
---     * 1 byte    : 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 purposes.
---
-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 'azureusStyle' encoding with the following args:
---
---      * 'HS' for the client id; ('defaultClientId')
---
---      * Version of the package for the version number;
---      ('defaultVersionNumber')
---
---      * UTC time day ++ day time for the random number. ('timestamp')
---
-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 "ML" = IMLdonkey
-  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
-
--- TODO use regexps
-
--- | Tries to extract meaningful information from peer ID bytes. If
--- peer id uses unknown coding style then client info returned is
--- 'def'.
---
-fingerprint :: PeerId -> Fingerprint
-fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
-  where
-    getCI    = do
-      leading <- BS.w2c <$> getWord8
-      case leading of
-        '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
-        'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
-        'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
-        'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
-        c   -> do
-          c1 <- w2c <$> S.lookAhead getWord8
-          if c1 == 'P'
-            then do
-                 _ <- getWord8
-                 Fingerprint <$> pure IOpera            <*> getOperaVersion
-            else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
-
-    getMainlineVersion = do
-      str <- BC.unpack <$> getByteString 7
-      let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
-      return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
-
-    getAzureusImpl    = parseImpl <$> getByteString 2
-    getAzureusVersion = mkVer     <$> getByteString 4
-      where
-        mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
-
-    getBitCometImpl = do
-      bs <- getByteString 3
-      S.lookAhead $ do
-        _  <- getByteString 2
-        lr <- getByteString 4
-        return $
-          if lr == "LORD" then IBitLord  else
-          if bs == "UTB"  then IBitComet else
-          if bs == "xbc"  then IBitComet else def
-
-    getBitCometVersion = do
-      x <- getWord8
-      y <- getWord8
-      return $ Version [fromIntegral x, fromIntegral y] []
-
-    getOperaVersion = do
-      str <- BC.unpack <$> getByteString 4
-      return $ Version [fromMaybe 0 $ readMaybe str] []
-
-    getShadowImpl 'A' = IABC
-    getShadowImpl 'O' = IOspreyPermaseed
-    getShadowImpl 'Q' = IBTQueue
-    getShadowImpl 'R' = ITribler
-    getShadowImpl 'S' = IShadow
-    getShadowImpl 'T' = IBitTornado
-    getShadowImpl  _  = IUnknown
-
-    decodeShadowVerNr :: Char -> Maybe Int
-    decodeShadowVerNr c
-      | '0' < c && c <= '9' = Just  (fromEnum c - fromEnum '0')
-      | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
-      | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
-      |        otherwise    = Nothing
-
-    getShadowVersion = do
-      str <- BC.unpack <$> getByteString 5
-      return $ Version (catMaybes $ L.map decodeShadowVerNr str) []