summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs27
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs8
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)
26import Data.Aeson.TH 26import Data.Aeson.TH
27import Data.BEncode as BS 27import Data.BEncode as BS
28import Data.BEncode.BDict (BKey) 28import Data.BEncode.BDict (BKey)
29import Data.ByteString
30import Data.ByteString.Char8 as BS8
29import Data.Bits 31import Data.Bits
30import Data.Char 32import Data.Char
31import Data.Default 33import Data.Default
@@ -35,6 +37,7 @@ import Data.Serialize as S
35import Data.String 37import Data.String
36import Data.Typeable 38import Data.Typeable
37import Data.Word 39import Data.Word
40import Data.IP
38import Network.Socket 41import Network.Socket
39import Text.PrettyPrint 42import Text.PrettyPrint
40import Text.PrettyPrint.Class 43import Text.PrettyPrint.Class
@@ -65,11 +68,13 @@ instance Serialize PortNumber where
65-- compact list encoding. 68-- compact list encoding.
66data PeerAddr = PeerAddr 69data 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) 75instance BEncode IP where
76 toBEncode ip = toBEncode $ BS8.pack $ show ip
77 fromBEncode (BString ip) = return $ fromString $ BS8.unpack ip
73 78
74peer_id_key, peer_ip_key, peer_port_key :: BKey 79peer_id_key, peer_ip_key, peer_port_key :: BKey
75peer_id_key = "peer id" 80peer_id_key = "peer id"
@@ -81,7 +86,7 @@ peer_port_key = "port"
81instance BEncode PeerAddr where 86instance 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--
98instance Serialize PeerAddr where 103instance 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--
120instance IsString PeerAddr where 125instance 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--
143peerSockAddr :: PeerAddr -> SockAddr 148peerSockAddr :: PeerAddr -> SockAddr
144peerSockAddr = SockAddrInet <$> peerPort <*> peerIP 149peerSockAddr 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
439instance ToJSON PeerList where
440 toJSON = toJSON . getPeerList
441
442instance FromJSON PeerList where
443 parseJSON v = PeerList <$> parseJSON v
444
445putCompactPeerList :: S.Putter [PeerAddr] 439putCompactPeerList :: S.Putter [PeerAddr]
446putCompactPeerList = mapM_ put 440putCompactPeerList = 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.
491instance BEncode AnnounceInfo where 483instance BEncode AnnounceInfo where
492 toBEncode (Failure t) = toDict $ 484 toBEncode (Failure t) = toDict $