diff options
Diffstat (limited to 'src/Network/BitTorrent/Peer.hs')
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs index 97c9f57f..cdcd65ea 100644 --- a/src/Network/BitTorrent/Peer.hs +++ b/src/Network/BitTorrent/Peer.hs | |||
@@ -43,7 +43,8 @@ module Network.BitTorrent.Peer | |||
43 | , defaultClientId, defaultVersionNumber | 43 | , defaultClientId, defaultVersionNumber |
44 | 44 | ||
45 | -- ** Generation | 45 | -- ** Generation |
46 | , genPeerId, timestampByteString | 46 | , genPeerId |
47 | , timestamp, entropy | ||
47 | 48 | ||
48 | -- ** Extra | 49 | -- ** Extra |
49 | , byteStringPadded | 50 | , byteStringPadded |
@@ -68,8 +69,6 @@ module Network.BitTorrent.Peer | |||
68 | 69 | ||
69 | 70 | ||
70 | import Control.Applicative | 71 | import Control.Applicative |
71 | import Control.Concurrent | ||
72 | import Control.Exception | ||
73 | import Data.BEncode | 72 | import Data.BEncode |
74 | import Data.Bits | 73 | import Data.Bits |
75 | import Data.Word | 74 | import Data.Word |
@@ -87,15 +86,16 @@ import Data.Time.Clock (getCurrentTime) | |||
87 | import Data.Time.Format (formatTime) | 86 | import Data.Time.Format (formatTime) |
88 | import Text.PrettyPrint (text, Doc, (<+>)) | 87 | import Text.PrettyPrint (text, Doc, (<+>)) |
89 | import System.Locale (defaultTimeLocale) | 88 | import System.Locale (defaultTimeLocale) |
90 | 89 | import System.Entropy (getEntropy) | |
91 | import Network hiding (accept) | 90 | import Network hiding (accept) |
92 | import Network.Socket | 91 | import Network.Socket |
93 | 92 | ||
94 | 93 | ||
95 | 94 | -- TODO we have linker error here, so manually hardcoded version for a | |
96 | -- TODO we have linker error here, so manual hardcoded version for a | ||
97 | -- while. | 95 | -- while. |
96 | |||
98 | -- import Paths_network_bittorrent (version) | 97 | -- import Paths_network_bittorrent (version) |
98 | |||
99 | version :: Version | 99 | version :: Version |
100 | version = Version [0, 10, 0, 0] [] | 100 | version = Version [0, 10, 0, 0] [] |
101 | 101 | ||
@@ -185,12 +185,17 @@ defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $ | |||
185 | -- format is used to make the ID's readable(for debugging) and more | 185 | -- format is used to make the ID's readable(for debugging) and more |
186 | -- or less random. | 186 | -- or less random. |
187 | -- | 187 | -- |
188 | timestampByteString :: IO ByteString | 188 | timestamp :: IO ByteString |
189 | timestampByteString = (BC.pack . format) <$> getCurrentTime | 189 | timestamp = (BC.pack . format) <$> getCurrentTime |
190 | where | 190 | where |
191 | format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | 191 | format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ |
192 | take 9 (reverse (formatTime defaultTimeLocale "%s" t)) | 192 | take 9 (reverse (formatTime defaultTimeLocale "%s" t)) |
193 | 193 | ||
194 | -- | Gives 15 character long random bytestring. This is more robust | ||
195 | -- method for generation of random part of peer ID than timestamp. | ||
196 | entropy :: IO ByteString | ||
197 | entropy = getEntropy 15 | ||
198 | |||
194 | -- | Here we use Azureus-style encoding with the following args: | 199 | -- | Here we use Azureus-style encoding with the following args: |
195 | -- | 200 | -- |
196 | -- * 'HS' for the client id. | 201 | -- * 'HS' for the client id. |
@@ -200,8 +205,7 @@ timestampByteString = (BC.pack . format) <$> getCurrentTime | |||
200 | -- * UTC time day ++ day time for the random number. | 205 | -- * UTC time day ++ day time for the random number. |
201 | -- | 206 | -- |
202 | genPeerId :: IO PeerId | 207 | genPeerId :: IO PeerId |
203 | genPeerId = azureusStyle defaultClientId defaultVersionNumber | 208 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> entropy |
204 | <$> timestampByteString | ||
205 | 209 | ||
206 | -- | Pad bytestring so it's becomes exactly request length. Conversion | 210 | -- | Pad bytestring so it's becomes exactly request length. Conversion |
207 | -- is done like so: | 211 | -- is done like so: |