1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
-- TODO: tests
-- | Recommended method for generation of the peer ID's is 'newPeerID',
-- though this module exports some other goodies for custom generation.
--
module Network.Torrent.PeerID
( PeerID (getPeerID)
-- * Encoding styles
, azureusStyle, shadowStyle
-- * Defaults
, defaultClientID, defaultVersionNumber
-- * Generation
, newPeerID, timestampByteString
-- * Extra
, byteStringPadded
) where
import Control.Applicative
import Data.BEncode
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.Builder as B
import Data.Foldable (foldMap)
import Data.Monoid ((<>))
import Data.Serialize
import Data.Version (Version(Version), versionBranch)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)
-- TODO we have linker error here, so manual hardcoded version for a while.
-- import Paths_network_bittorrent (version)
version :: Version
version = Version [0, 10, 0, 0] []
-- | Peer identifier is exactly 20 bytes long bytestring.
newtype PeerID = PeerID { getPeerID :: ByteString }
deriving (Show, Eq, Ord, BEncodable)
instance Serialize PeerID where
put = putByteString . getPeerID
get = PeerID <$> getBytes 20
-- | Azureus-style encoding:
-- * 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:
-- * 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.
--
timestampByteString :: IO ByteString
timestampByteString = (BC.pack . format) <$> getCurrentTime
where
format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
take 9 (reverse (formatTime defaultTimeLocale "%s" t))
-- | 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.
--
newPeerID :: IO PeerID
newPeerID = azureusStyle defaultClientID defaultVersionNumber
<$> timestampByteString
-- | 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
|
