summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/PeerID.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/PeerID.hs')
-rw-r--r--src/Network/BitTorrent/PeerID.hs50
1 files changed, 6 insertions, 44 deletions
diff --git a/src/Network/BitTorrent/PeerID.hs b/src/Network/BitTorrent/PeerID.hs
index cef1fa58..2c8818fe 100644
--- a/src/Network/BitTorrent/PeerID.hs
+++ b/src/Network/BitTorrent/PeerID.hs
@@ -8,17 +8,14 @@
8-- 8--
9-- This module provides 'Peer' and 'PeerID' datatypes and all related 9-- This module provides 'Peer' and 'PeerID' datatypes and all related
10-- operations. 10-- operations.
11--
11-- Recommended method for generation of the peer ID's is 'newPeerID', 12-- Recommended method for generation of the peer ID's is 'newPeerID',
12-- though this module exports some other goodies for custom generation. 13-- though this module exports some other goodies for custom generation.
13-- 14--
14{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-} 15{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
15module Network.BitTorrent.PeerID 16module Network.BitTorrent.PeerID
16 ( -- * Peer addr 17 ( -- * Peer identification
17 Peer(..) 18 PeerID (getPeerID), ppPeerID
18 , peerSockAddr, connectToPeer
19
20 -- * Peer identification
21 , PeerID (getPeerID)
22 19
23 -- ** Encoding styles 20 -- ** Encoding styles
24 , azureusStyle, shadowStyle 21 , azureusStyle, shadowStyle
@@ -34,8 +31,6 @@ module Network.BitTorrent.PeerID
34 ) where 31 ) where
35 32
36import Control.Applicative 33import Control.Applicative
37import Data.Word
38import Data.Bits
39import Data.BEncode 34import Data.BEncode
40import Data.ByteString (ByteString) 35import Data.ByteString (ByteString)
41import qualified Data.ByteString as B 36import qualified Data.ByteString as B
@@ -50,8 +45,6 @@ import Data.Version (Version(Version), versionBranch)
50import Data.Time.Clock (getCurrentTime) 45import Data.Time.Clock (getCurrentTime)
51import Data.Time.Format (formatTime) 46import Data.Time.Format (formatTime)
52import System.Locale (defaultTimeLocale) 47import System.Locale (defaultTimeLocale)
53import Network
54import Network.Socket
55 48
56 49
57-- TODO we have linker error here, so manual hardcoded version for a while. 50-- TODO we have linker error here, so manual hardcoded version for a while.
@@ -60,40 +53,6 @@ version :: Version
60version = Version [0, 10, 0, 0] [] 53version = Version [0, 10, 0, 0] []
61 54
62 55
63
64data Peer = Peer {
65 peerID :: Maybe PeerID
66 , peerIP :: HostAddress
67 , peerPort :: PortNumber
68 } deriving Show
69
70-- TODO make platform independent, clarify htonl
71-- | Convert peer info from tracker response to socket address.
72-- Used for establish connection between peers.
73--
74peerSockAddr :: Peer -> SockAddr
75peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
76 where
77 htonl :: Word32 -> Word32
78 htonl d =
79 ((d .&. 0xff) `shiftL` 24) .|.
80 (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
81 (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
82 ((d `shiftR` 24) .&. 0xff)
83
84 g :: PortNumber -> PortNumber
85 g = id
86
87-- ipv6 extension
88-- | Tries to connect to peer using reasonable default parameters.
89--
90connectToPeer :: Peer -> IO Socket
91connectToPeer p = do
92 sock <- socket AF_INET Stream Network.Socket.defaultProtocol
93 connect sock (peerSockAddr p)
94 return sock
95
96
97-- | Peer identifier is exactly 20 bytes long bytestring. 56-- | Peer identifier is exactly 20 bytes long bytestring.
98newtype PeerID = PeerID { getPeerID :: ByteString } 57newtype PeerID = PeerID { getPeerID :: ByteString }
99 deriving (Show, Eq, Ord, BEncodable) 58 deriving (Show, Eq, Ord, BEncodable)
@@ -105,6 +64,9 @@ instance Serialize PeerID where
105instance URLShow PeerID where 64instance URLShow PeerID where
106 urlShow = BC.unpack . getPeerID 65 urlShow = BC.unpack . getPeerID
107 66
67ppPeerID :: PeerID -> String
68ppPeerID = BC.unpack . getPeerID
69
108 70
109-- | Azureus-style encoding have the following layout: 71-- | Azureus-style encoding have the following layout:
110-- 72--