diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 37 |
1 files changed, 34 insertions, 3 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index 71c92a15..846a14f9 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -21,19 +21,25 @@ module Network.BitTorrent.Core.PeerAddr | |||
21 | ) where | 21 | ) where |
22 | 22 | ||
23 | import Control.Applicative | 23 | import Control.Applicative |
24 | import Control.Exception | ||
24 | import Data.Aeson (ToJSON, FromJSON) | 25 | import Data.Aeson (ToJSON, FromJSON) |
25 | import Data.Aeson.TH | 26 | import Data.Aeson.TH |
26 | import Data.BEncode as BS | 27 | import Data.BEncode as BS |
27 | import Data.BEncode.BDict (BKey) | 28 | import Data.BEncode.BDict (BKey) |
28 | import Data.Bits | 29 | import Data.Bits |
29 | import Data.Char | 30 | import Data.Char |
31 | import Data.Default | ||
30 | import Data.List as L | 32 | import Data.List as L |
33 | import Data.List.Split | ||
31 | import Data.Serialize as S | 34 | import Data.Serialize as S |
35 | import Data.String | ||
32 | import Data.Typeable | 36 | import Data.Typeable |
33 | import Data.Word | 37 | import Data.Word |
34 | import Network.Socket | 38 | import Network.Socket |
35 | import Text.PrettyPrint | 39 | import Text.PrettyPrint |
36 | import Text.PrettyPrint.Class | 40 | import Text.PrettyPrint.Class |
41 | import Text.Read (readMaybe) | ||
42 | import System.IO.Unsafe | ||
37 | 43 | ||
38 | import Network.BitTorrent.Core.PeerId | 44 | import Network.BitTorrent.Core.PeerId |
39 | 45 | ||
@@ -70,7 +76,7 @@ peer_ip_key = "ip" | |||
70 | peer_port_key = "port" | 76 | peer_port_key = "port" |
71 | 77 | ||
72 | -- FIXME do we need to byteswap peerIP in bencode instance? | 78 | -- FIXME do we need to byteswap peerIP in bencode instance? |
73 | -- | The tracker announce response compatible encoding. | 79 | -- | The tracker's 'announce response' compatible encoding. |
74 | instance BEncode PeerAddr where | 80 | instance BEncode PeerAddr where |
75 | toBEncode PeerAddr {..} = toDict $ | 81 | toBEncode PeerAddr {..} = toDict $ |
76 | peer_id_key .=? peerId | 82 | peer_id_key .=? peerId |
@@ -83,17 +89,42 @@ instance BEncode PeerAddr where | |||
83 | <*>! peer_ip_key | 89 | <*>! peer_ip_key |
84 | <*>! peer_port_key | 90 | <*>! peer_port_key |
85 | 91 | ||
86 | -- | The tracker "compact peer list" compatible encoding. The | 92 | -- | The tracker's 'compact peer list' compatible encoding. The |
87 | -- 'peerId' is always 'Nothing'. | 93 | -- 'peerId' is always 'Nothing'. |
88 | -- | 94 | -- |
89 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | 95 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> |
90 | -- | 96 | -- |
91 | instance Serialize PeerAddr where | 97 | instance Serialize PeerAddr where |
92 | put PeerAddr {..} = putWord32host peerId >> putWord peerPort | 98 | put PeerAddr {..} = putWord32host peerIP >> put peerPort |
93 | {-# INLINE put #-} | 99 | {-# INLINE put #-} |
94 | get = PeerAddr Nothing <$> getWord32host <*> get | 100 | get = PeerAddr Nothing <$> getWord32host <*> get |
95 | {-# INLINE get #-} | 101 | {-# INLINE get #-} |
96 | 102 | ||
103 | -- | @127.0.0.1:6881@ | ||
104 | instance Default PeerAddr where | ||
105 | def = "127.0.0.1:6881" | ||
106 | |||
107 | -- inet_addr is pure; so it is safe to throw IO | ||
108 | unsafeCatchIO :: IO a -> Maybe a | ||
109 | unsafeCatchIO m = unsafePerformIO $ | ||
110 | catch (m >>= evaluate >>= return . Just) handler | ||
111 | where | ||
112 | handler :: IOError -> IO (Maybe a) | ||
113 | handler _ = pure Nothing | ||
114 | |||
115 | -- | Example: | ||
116 | -- | ||
117 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | ||
118 | -- | ||
119 | instance IsString PeerAddr where | ||
120 | fromString str | ||
121 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | ||
122 | , Just hostAddr <- unsafeCatchIO $ inet_addr hostAddrStr | ||
123 | , Just portNum <- toEnum <$> readMaybe portStr | ||
124 | = PeerAddr Nothing hostAddr portNum | ||
125 | | otherwise = error $ "fromString: unable to parse PeerAddr: " ++ str | ||
126 | |||
127 | -- | fingerprint + "at" + dotted.host.inet.addr:port | ||
97 | instance Pretty PeerAddr where | 128 | instance Pretty PeerAddr where |
98 | pretty p @ PeerAddr {..} | 129 | pretty p @ PeerAddr {..} |
99 | | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr | 130 | | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr |