summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT/Message.hs')
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs15
1 files changed, 9 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 9000a9be..0733a85d 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -101,7 +101,7 @@ instance BEncode Ping where
101 fromBEncode _ = pure Ping 101 fromBEncode _ = pure Ping
102 102
103-- | \"q\" = \"ping\" 103-- | \"q\" = \"ping\"
104instance KRPC (Query Ping) [Ping] where 104instance KRPC (Query Ping) (Response Ping) where
105 method = "ping" 105 method = "ping"
106 106
107{----------------------------------------------------------------------- 107{-----------------------------------------------------------------------
@@ -130,15 +130,18 @@ newtype NodeFound ip = NodeFound [NodeInfo ip]
130nodes_key :: BKey 130nodes_key :: BKey
131nodes_key = "nodes" 131nodes_key = "nodes"
132 132
133binary :: Serialize a => BE.Get BS.ByteString -> BE.Get a 133binary :: Serialize a => BKey -> BE.Get [a]
134binary m = m >>= either fail return . S.decode 134binary k = field (req k) >>= either (fail . format) return .
135 runGet (many get)
136 where
137 format str = "fail to deserialize " ++ show k ++ " field: " ++ str
135 138
136instance (Typeable ip, Serialize ip) => BEncode (NodeFound ip) where 139instance (Typeable ip, Serialize ip) => BEncode (NodeFound ip) where
137 toBEncode (NodeFound ns) = toDict $ 140 toBEncode (NodeFound ns) = toDict $
138 nodes_key .=! S.encode ns 141 nodes_key .=! S.encode ns
139 .: endDict 142 .: endDict
140 143
141 fromBEncode = fromDict $ NodeFound <$> binary (field (req nodes_key)) 144 fromBEncode = fromDict $ NodeFound <$> binary nodes_key
142 145
143-- | \"q\" == \"find_node\" 146-- | \"q\" == \"find_node\"
144instance (Serialize ip, Typeable ip) 147instance (Serialize ip, Typeable ip)
@@ -188,8 +191,8 @@ instance (Typeable ip, Serialize ip) => BEncode (GotPeers ip) where
188 191
189 fromBEncode = fromDict $ GotPeers <$> getPeerList <*>! token_key 192 fromBEncode = fromDict $ GotPeers <$> getPeerList <*>! token_key
190 where 193 where
191 getPeerList = Right <$> binary (field (req peers_key)) 194 getPeerList = Right <$> binary peers_key
192 <|> Left <$> binary (field (req nodes_key)) 195 <|> Left <$> binary nodes_key
193 196
194instance (Typeable ip, Serialize ip) => 197instance (Typeable ip, Serialize ip) =>
195 KRPC (Query GetPeers) (Response (GotPeers ip)) where 198 KRPC (Query GetPeers) (Response (GotPeers ip)) where