diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 27 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 8 |
2 files changed, 17 insertions, 18 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index e7a4ea61..94510bba 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -26,6 +26,8 @@ import Data.Aeson (ToJSON, FromJSON) | |||
26 | import Data.Aeson.TH | 26 | import Data.Aeson.TH |
27 | import Data.BEncode as BS | 27 | import Data.BEncode as BS |
28 | import Data.BEncode.BDict (BKey) | 28 | import Data.BEncode.BDict (BKey) |
29 | import Data.ByteString | ||
30 | import Data.ByteString.Char8 as BS8 | ||
29 | import Data.Bits | 31 | import Data.Bits |
30 | import Data.Char | 32 | import Data.Char |
31 | import Data.Default | 33 | import Data.Default |
@@ -35,6 +37,7 @@ import Data.Serialize as S | |||
35 | import Data.String | 37 | import Data.String |
36 | import Data.Typeable | 38 | import Data.Typeable |
37 | import Data.Word | 39 | import Data.Word |
40 | import Data.IP | ||
38 | import Network.Socket | 41 | import Network.Socket |
39 | import Text.PrettyPrint | 42 | import Text.PrettyPrint |
40 | import Text.PrettyPrint.Class | 43 | import Text.PrettyPrint.Class |
@@ -65,11 +68,13 @@ instance Serialize PortNumber where | |||
65 | -- compact list encoding. | 68 | -- compact list encoding. |
66 | data PeerAddr = PeerAddr | 69 | data PeerAddr = PeerAddr |
67 | { peerId :: !(Maybe PeerId) | 70 | { peerId :: !(Maybe PeerId) |
68 | , peerIP :: {-# UNPACK #-} !HostAddress | 71 | , peerIP :: {-# UNPACK #-} !IP |
69 | , peerPort :: {-# UNPACK #-} !PortNumber | 72 | , peerPort :: {-# UNPACK #-} !PortNumber |
70 | } deriving (Show, Eq, Ord, Typeable) | 73 | } deriving (Show, Eq, Typeable) |
71 | 74 | ||
72 | $(deriveJSON omitRecordPrefix ''PeerAddr) | 75 | instance BEncode IP where |
76 | toBEncode ip = toBEncode $ BS8.pack $ show ip | ||
77 | fromBEncode (BString ip) = return $ fromString $ BS8.unpack ip | ||
73 | 78 | ||
74 | peer_id_key, peer_ip_key, peer_port_key :: BKey | 79 | peer_id_key, peer_ip_key, peer_port_key :: BKey |
75 | peer_id_key = "peer id" | 80 | peer_id_key = "peer id" |
@@ -81,7 +86,7 @@ peer_port_key = "port" | |||
81 | instance BEncode PeerAddr where | 86 | instance BEncode PeerAddr where |
82 | toBEncode PeerAddr {..} = toDict $ | 87 | toBEncode PeerAddr {..} = toDict $ |
83 | peer_id_key .=? peerId | 88 | peer_id_key .=? peerId |
84 | .: peer_ip_key .=! peerIP | 89 | .: peer_ip_key .=! BS8.pack (show peerIP) |
85 | .: peer_port_key .=! peerPort | 90 | .: peer_port_key .=! peerPort |
86 | .: endDict | 91 | .: endDict |
87 | 92 | ||
@@ -95,10 +100,10 @@ instance BEncode PeerAddr where | |||
95 | -- | 100 | -- |
96 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | 101 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> |
97 | -- | 102 | -- |
98 | instance Serialize PeerAddr where | 103 | instance Serialize PeerAddr where -- TODO do it properly |
99 | put PeerAddr {..} = putWord32host peerIP >> put peerPort | 104 | put PeerAddr {..} = (putWord32host $ toHostAddress $ ipv4 peerIP) >> put peerPort |
100 | {-# INLINE put #-} | 105 | {-# INLINE put #-} |
101 | get = PeerAddr Nothing <$> getWord32host <*> get | 106 | get = PeerAddr Nothing <$> (IPv4 . fromHostAddress <$> getWord32host) <*> get |
102 | {-# INLINE get #-} | 107 | {-# INLINE get #-} |
103 | 108 | ||
104 | -- | @127.0.0.1:6881@ | 109 | -- | @127.0.0.1:6881@ |
@@ -118,9 +123,9 @@ unsafeCatchIO m = unsafePerformIO $ | |||
118 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | 123 | -- @peerPort \"127.0.0.1:6881\" == 6881@ |
119 | -- | 124 | -- |
120 | instance IsString PeerAddr where | 125 | instance IsString PeerAddr where |
121 | fromString str | 126 | fromString str -- TODO IPv6 |
122 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | 127 | | [hostAddrStr, portStr] <- splitWhen (== ':') str |
123 | , Just hostAddr <- unsafeCatchIO $ inet_addr hostAddrStr | 128 | , Just hostAddr <- read hostAddrStr |
124 | , Just portNum <- toEnum <$> readMaybe portStr | 129 | , Just portNum <- toEnum <$> readMaybe portStr |
125 | = PeerAddr Nothing hostAddr portNum | 130 | = PeerAddr Nothing hostAddr portNum |
126 | | otherwise = error $ "fromString: unable to parse PeerAddr: " ++ str | 131 | | otherwise = error $ "fromString: unable to parse PeerAddr: " ++ str |
@@ -141,4 +146,6 @@ defaultPorts = [6881..6889] | |||
141 | -- for establish connection between peers. | 146 | -- for establish connection between peers. |
142 | -- | 147 | -- |
143 | peerSockAddr :: PeerAddr -> SockAddr | 148 | peerSockAddr :: PeerAddr -> SockAddr |
144 | peerSockAddr = SockAddrInet <$> peerPort <*> peerIP | 149 | peerSockAddr PeerAddr {..} |
150 | | IPv4 v4 <- peerIP = SockAddrInet peerPort (toHostAddress v4) | ||
151 | | IPv6 v6 <- peerIP = SockAddrInet6 peerPort 0 (toHostAddress6 v6) 0 | ||
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index fe7686cb..6249cdc4 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -436,12 +436,6 @@ data PeerList | |||
436 | | CompactPeerList { getPeerList :: [PeerAddr] } | 436 | | CompactPeerList { getPeerList :: [PeerAddr] } |
437 | deriving (Show, Eq, Typeable) | 437 | deriving (Show, Eq, Typeable) |
438 | 438 | ||
439 | instance ToJSON PeerList where | ||
440 | toJSON = toJSON . getPeerList | ||
441 | |||
442 | instance FromJSON PeerList where | ||
443 | parseJSON v = PeerList <$> parseJSON v | ||
444 | |||
445 | putCompactPeerList :: S.Putter [PeerAddr] | 439 | putCompactPeerList :: S.Putter [PeerAddr] |
446 | putCompactPeerList = mapM_ put | 440 | putCompactPeerList = mapM_ put |
447 | 441 | ||
@@ -485,8 +479,6 @@ data AnnounceInfo = | |||
485 | , respWarning :: !(Maybe Text) | 479 | , respWarning :: !(Maybe Text) |
486 | } deriving (Show, Typeable) | 480 | } deriving (Show, Typeable) |
487 | 481 | ||
488 | $(deriveJSON omitRecordPrefix ''AnnounceInfo) | ||
489 | |||
490 | -- | HTTP tracker protocol compatible encoding. | 482 | -- | HTTP tracker protocol compatible encoding. |
491 | instance BEncode AnnounceInfo where | 483 | instance BEncode AnnounceInfo where |
492 | toBEncode (Failure t) = toDict $ | 484 | toBEncode (Failure t) = toDict $ |