module Network.BitTorrent.Core.PeerId
(
PeerId (getPeerId)
, ppPeerId
, genPeerId
, timestamp
, entropy
, azureusStyle
, shadowStyle
, clientInfo
, 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
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
ppPeerId :: PeerId -> Doc
ppPeerId = text . BC.unpack . getPeerId
byteStringPadded :: ByteString
-> Int
-> Char
-> 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
azureusStyle :: ByteString
-> ByteString
-> ByteString
-> PeerId
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'
shadowStyle :: Char
-> ByteString
-> ByteString
-> PeerId
shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
BS.char8 cid <>
byteStringPadded ver 4 '-' <>
byteStringPadded rnd 15 '0'
defaultClientId :: ByteString
defaultClientId = "HS"
defaultVersionNumber :: ByteString
defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
versionBranch version
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))
entropy :: IO ByteString
entropy = getEntropy 15
genPeerId :: IO PeerId
genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
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
clientInfo :: PeerId -> ClientInfo
clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
where
getCI = getWord8 >> ClientInfo <$> getClientImpl <*> getClientVersion
getClientImpl = parseImpl <$> getByteString 2
getClientVersion = mkVer <$> getByteString 4
where
mkVer bs = ClientVersion $ Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []