diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Address.hs | 23 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Message.hs | 100 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Query.hs | 13 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Session.hs | 5 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Token.hs | 10 | ||||
-rw-r--r-- | src/Network/KRPC/Manager.hs | 137 | ||||
-rw-r--r-- | src/Network/KRPC/Message.hs | 75 | ||||
-rw-r--r-- | src/Network/KRPC/Method.hs | 26 |
8 files changed, 353 insertions, 36 deletions
diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs index a8e12b35..2132f8f9 100644 --- a/src/Network/BitTorrent/Address.hs +++ b/src/Network/BitTorrent/Address.hs | |||
@@ -91,8 +91,10 @@ module Network.BitTorrent.Address | |||
91 | import Control.Applicative | 91 | import Control.Applicative |
92 | import Control.Monad | 92 | import Control.Monad |
93 | import Control.Exception (onException) | 93 | import Control.Exception (onException) |
94 | #ifdef VERSION_bencoding | ||
94 | import Data.BEncode as BE | 95 | import Data.BEncode as BE |
95 | import Data.BEncode.BDict (BKey) | 96 | import Data.BEncode.BDict (BKey) |
97 | #endif | ||
96 | import Data.Bits | 98 | import Data.Bits |
97 | import qualified Data.ByteString as BS | 99 | import qualified Data.ByteString as BS |
98 | import qualified Data.ByteString.Internal as BS | 100 | import qualified Data.ByteString.Internal as BS |
@@ -204,7 +206,11 @@ instance Address a => Address (PeerAddr a) where | |||
204 | 206 | ||
205 | -- | Peer identifier is exactly 20 bytes long bytestring. | 207 | -- | Peer identifier is exactly 20 bytes long bytestring. |
206 | newtype PeerId = PeerId { getPeerId :: ByteString } | 208 | newtype PeerId = PeerId { getPeerId :: ByteString } |
207 | deriving (Show, Eq, Ord, BEncode, Typeable) | 209 | deriving ( Show, Eq, Ord, Typeable |
210 | #ifdef VERSION_bencoding | ||
211 | , BEncode | ||
212 | #endif | ||
213 | ) | ||
208 | 214 | ||
209 | peerIdLen :: Int | 215 | peerIdLen :: Int |
210 | peerIdLen = 20 | 216 | peerIdLen = 20 |
@@ -369,6 +375,7 @@ genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp | |||
369 | -- Port number | 375 | -- Port number |
370 | -----------------------------------------------------------------------} | 376 | -----------------------------------------------------------------------} |
371 | 377 | ||
378 | #ifdef VERSION_bencoding | ||
372 | instance BEncode PortNumber where | 379 | instance BEncode PortNumber where |
373 | toBEncode = toBEncode . fromEnum | 380 | toBEncode = toBEncode . fromEnum |
374 | fromBEncode = fromBEncode >=> portNumber | 381 | fromBEncode = fromBEncode >=> portNumber |
@@ -378,6 +385,7 @@ instance BEncode PortNumber where | |||
378 | | 0 <= n && n <= fromIntegral (maxBound :: Word16) | 385 | | 0 <= n && n <= fromIntegral (maxBound :: Word16) |
379 | = pure $ fromIntegral n | 386 | = pure $ fromIntegral n |
380 | | otherwise = decodingError $ "PortNumber: " ++ show n | 387 | | otherwise = decodingError $ "PortNumber: " ++ show n |
388 | #endif | ||
381 | 389 | ||
382 | instance Serialize PortNumber where | 390 | instance Serialize PortNumber where |
383 | get = fromIntegral <$> getWord16be | 391 | get = fromIntegral <$> getWord16be |
@@ -417,6 +425,7 @@ deriving instance Typeable IP | |||
417 | deriving instance Typeable IPv4 | 425 | deriving instance Typeable IPv4 |
418 | deriving instance Typeable IPv6 | 426 | deriving instance Typeable IPv6 |
419 | 427 | ||
428 | #ifdef VERSION_bencoding | ||
420 | ipToBEncode :: Show i => i -> BValue | 429 | ipToBEncode :: Show i => i -> BValue |
421 | ipToBEncode ip = BString $ BS8.pack $ show ip | 430 | ipToBEncode ip = BString $ BS8.pack $ show ip |
422 | {-# INLINE ipToBEncode #-} | 431 | {-# INLINE ipToBEncode #-} |
@@ -444,6 +453,7 @@ instance BEncode IPv6 where | |||
444 | {-# INLINE toBEncode #-} | 453 | {-# INLINE toBEncode #-} |
445 | fromBEncode = ipFromBEncode | 454 | fromBEncode = ipFromBEncode |
446 | {-# INLINE fromBEncode #-} | 455 | {-# INLINE fromBEncode #-} |
456 | #endif | ||
447 | 457 | ||
448 | -- | When 'get'ing an IP it must be 'isolate'd to the appropriate | 458 | -- | When 'get'ing an IP it must be 'isolate'd to the appropriate |
449 | -- number of bytes since we have no other way of telling which | 459 | -- number of bytes since we have no other way of telling which |
@@ -508,6 +518,7 @@ data PeerAddr a = PeerAddr | |||
508 | , peerPort :: {-# UNPACK #-} !PortNumber | 518 | , peerPort :: {-# UNPACK #-} !PortNumber |
509 | } deriving (Show, Eq, Ord, Typeable, Functor) | 519 | } deriving (Show, Eq, Ord, Typeable, Functor) |
510 | 520 | ||
521 | #ifdef VERSION_bencoding | ||
511 | peer_ip_key, peer_id_key, peer_port_key :: BKey | 522 | peer_ip_key, peer_id_key, peer_port_key :: BKey |
512 | peer_ip_key = "ip" | 523 | peer_ip_key = "ip" |
513 | peer_id_key = "peer id" | 524 | peer_id_key = "peer id" |
@@ -527,6 +538,7 @@ instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | |||
527 | <*>! peer_port_key | 538 | <*>! peer_port_key |
528 | where | 539 | where |
529 | peerAddr = flip PeerAddr | 540 | peerAddr = flip PeerAddr |
541 | #endif | ||
530 | 542 | ||
531 | -- | The tracker's 'compact peer list' compatible encoding. The | 543 | -- | The tracker's 'compact peer list' compatible encoding. The |
532 | -- 'peerId' is always 'Nothing'. | 544 | -- 'peerId' is always 'Nothing'. |
@@ -642,7 +654,12 @@ peerSocket socketType pa = do | |||
642 | -- Normally, /this/ node id should be saved between invocations | 654 | -- Normally, /this/ node id should be saved between invocations |
643 | -- of the client software. | 655 | -- of the client software. |
644 | newtype NodeId = NodeId ByteString | 656 | newtype NodeId = NodeId ByteString |
645 | deriving (Show, Eq, Ord, BEncode, Typeable) | 657 | deriving (Show, Eq, Ord, Typeable |
658 | #ifdef VERSION_bencoding | ||
659 | , BEncode | ||
660 | #endif | ||
661 | ) | ||
662 | |||
646 | 663 | ||
647 | nodeIdSize :: Int | 664 | nodeIdSize :: Int |
648 | nodeIdSize = 20 | 665 | nodeIdSize = 20 |
@@ -771,12 +788,14 @@ instance Serialize a => Serialize (NodeAddr a) where | |||
771 | put NodeAddr {..} = put nodeHost >> put nodePort | 788 | put NodeAddr {..} = put nodeHost >> put nodePort |
772 | {-# INLINE put #-} | 789 | {-# INLINE put #-} |
773 | 790 | ||
791 | #ifdef VERSION_bencoding | ||
774 | -- | Torrent file compatible encoding. | 792 | -- | Torrent file compatible encoding. |
775 | instance BEncode a => BEncode (NodeAddr a) where | 793 | instance BEncode a => BEncode (NodeAddr a) where |
776 | toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort) | 794 | toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort) |
777 | {-# INLINE toBEncode #-} | 795 | {-# INLINE toBEncode #-} |
778 | fromBEncode b = uncurry NodeAddr <$> fromBEncode b | 796 | fromBEncode b = uncurry NodeAddr <$> fromBEncode b |
779 | {-# INLINE fromBEncode #-} | 797 | {-# INLINE fromBEncode #-} |
798 | #endif | ||
780 | 799 | ||
781 | instance Hashable a => Hashable (NodeAddr a) where | 800 | instance Hashable a => Hashable (NodeAddr a) where |
782 | hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort) | 801 | hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort) |
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs index 1f835fa6..44dc9b2f 100644 --- a/src/Network/BitTorrent/DHT/Message.hs +++ b/src/Network/BitTorrent/DHT/Message.hs | |||
@@ -55,6 +55,7 @@ | |||
55 | -- For Kamelia messages see original Kademlia paper: | 55 | -- For Kamelia messages see original Kademlia paper: |
56 | -- <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf> | 56 | -- <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf> |
57 | -- | 57 | -- |
58 | {-# LANGUAGE CPP #-} | ||
58 | {-# LANGUAGE DeriveDataTypeable #-} | 59 | {-# LANGUAGE DeriveDataTypeable #-} |
59 | {-# LANGUAGE FlexibleInstances #-} | 60 | {-# LANGUAGE FlexibleInstances #-} |
60 | {-# LANGUAGE MultiParamTypeClasses #-} | 61 | {-# LANGUAGE MultiParamTypeClasses #-} |
@@ -73,6 +74,8 @@ module Network.BitTorrent.DHT.Message | |||
73 | , FindNode (..) | 74 | , FindNode (..) |
74 | , NodeFound (..) | 75 | , NodeFound (..) |
75 | 76 | ||
77 | |||
78 | #ifdef VERSION_bencoding | ||
76 | -- ** get_peers | 79 | -- ** get_peers |
77 | , PeerList | 80 | , PeerList |
78 | , GetPeers (..) | 81 | , GetPeers (..) |
@@ -81,12 +84,23 @@ module Network.BitTorrent.DHT.Message | |||
81 | -- ** announce_peer | 84 | -- ** announce_peer |
82 | , Announce (..) | 85 | , Announce (..) |
83 | , Announced (..) | 86 | , Announced (..) |
87 | #endif | ||
84 | ) where | 88 | ) where |
85 | 89 | ||
86 | import Control.Applicative | 90 | import Control.Applicative |
87 | import Data.Bool | 91 | import Data.Bool |
92 | #ifdef VERSION_bencoding | ||
88 | import Data.BEncode as BE | 93 | import Data.BEncode as BE |
89 | import Data.BEncode.BDict as BDict | 94 | import Data.BEncode.BDict as BDict |
95 | import Network.BitTorrent.Address | ||
96 | #else | ||
97 | import qualified Data.Tox as Tox | ||
98 | import Data.Tox (NodeId) | ||
99 | import Data.Word | ||
100 | import Control.Monad | ||
101 | import Network.KRPC.Method | ||
102 | import Network.BitTorrent.Address hiding (NodeId) | ||
103 | #endif | ||
90 | import Data.ByteString (ByteString) | 104 | import Data.ByteString (ByteString) |
91 | import Data.List as L | 105 | import Data.List as L |
92 | import Data.Monoid | 106 | import Data.Monoid |
@@ -97,7 +111,6 @@ import Network.KRPC | |||
97 | import Data.Maybe | 111 | import Data.Maybe |
98 | 112 | ||
99 | import Data.Torrent (InfoHash) | 113 | import Data.Torrent (InfoHash) |
100 | import Network.BitTorrent.Address | ||
101 | import Network.BitTorrent.DHT.Token | 114 | import Network.BitTorrent.DHT.Token |
102 | import Network.KRPC () | 115 | import Network.KRPC () |
103 | 116 | ||
@@ -105,6 +118,10 @@ import Network.KRPC () | |||
105 | -- envelopes | 118 | -- envelopes |
106 | -----------------------------------------------------------------------} | 119 | -----------------------------------------------------------------------} |
107 | 120 | ||
121 | #ifndef VERSION_bencoding | ||
122 | type BKey = ByteString | ||
123 | #endif | ||
124 | |||
108 | node_id_key :: BKey | 125 | node_id_key :: BKey |
109 | node_id_key = "id" | 126 | node_id_key = "id" |
110 | 127 | ||
@@ -112,6 +129,7 @@ read_only_key :: BKey | |||
112 | read_only_key = "ro" | 129 | read_only_key = "ro" |
113 | 130 | ||
114 | 131 | ||
132 | #ifdef VERSION_bencoding | ||
115 | -- | All queries have an \"id\" key and value containing the node ID | 133 | -- | All queries have an \"id\" key and value containing the node ID |
116 | -- of the querying node. | 134 | -- of the querying node. |
117 | data Query a = Query | 135 | data Query a = Query |
@@ -134,7 +152,11 @@ instance BEncode a => BEncode (Query a) where | |||
134 | Query <$> fromDict (field (req node_id_key)) v | 152 | Query <$> fromDict (field (req node_id_key)) v |
135 | <*> fromDict (fromMaybe False <$>? read_only_key) v | 153 | <*> fromDict (fromMaybe False <$>? read_only_key) v |
136 | <*> fromBEncode v | 154 | <*> fromBEncode v |
155 | #else | ||
156 | data Query a = Query a | ||
157 | #endif | ||
137 | 158 | ||
159 | #ifdef VERSION_bencoding | ||
138 | -- | All responses have an \"id\" key and value containing the node ID | 160 | -- | All responses have an \"id\" key and value containing the node ID |
139 | -- of the responding node. | 161 | -- of the responding node. |
140 | data Response a = Response | 162 | data Response a = Response |
@@ -150,7 +172,9 @@ instance BEncode a => BEncode (Response a) where | |||
150 | fromBEncode b = fromQuery <$> fromBEncode b | 172 | fromBEncode b = fromQuery <$> fromBEncode b |
151 | where | 173 | where |
152 | fromQuery (Query nid _ a) = Response nid a | 174 | fromQuery (Query nid _ a) = Response nid a |
153 | 175 | #else | |
176 | data Response a = Response a | ||
177 | #endif | ||
154 | 178 | ||
155 | {----------------------------------------------------------------------- | 179 | {----------------------------------------------------------------------- |
156 | -- ping method | 180 | -- ping method |
@@ -158,16 +182,45 @@ instance BEncode a => BEncode (Response a) where | |||
158 | 182 | ||
159 | -- | The most basic query is a ping. Ping query is used to check if a | 183 | -- | The most basic query is a ping. Ping query is used to check if a |
160 | -- quered node is still alive. | 184 | -- quered node is still alive. |
185 | #ifdef VERSION_bencoding | ||
161 | data Ping = Ping | 186 | data Ping = Ping |
187 | #else | ||
188 | data Ping = Ping Tox.Nonce8 | ||
189 | #endif | ||
162 | deriving (Show, Eq, Typeable) | 190 | deriving (Show, Eq, Typeable) |
163 | 191 | ||
192 | #ifdef VERSION_bencoding | ||
164 | instance BEncode Ping where | 193 | instance BEncode Ping where |
165 | toBEncode Ping = toDict endDict | 194 | toBEncode Ping = toDict endDict |
166 | fromBEncode _ = pure Ping | 195 | fromBEncode _ = pure Ping |
196 | #else | ||
197 | instance Serialize (Query Ping) where | ||
198 | get = do | ||
199 | b <- get | ||
200 | when ( (b::Word8) /= 0) $ fail "Bad ping request" | ||
201 | nonce <- get | ||
202 | return $ Query (Ping nonce) | ||
203 | put (Query (Ping nonce)) = do | ||
204 | put (0 :: Word8) | ||
205 | put nonce | ||
206 | instance Serialize (Response Ping) where | ||
207 | get = do | ||
208 | b <- get | ||
209 | when ( (b::Word8) /= 1) $ fail "Bad ping response" | ||
210 | nonce <- get | ||
211 | return $ Response (Ping nonce) | ||
212 | put (Response (Ping nonce)) = do | ||
213 | put (1 :: Word8) | ||
214 | put nonce | ||
215 | #endif | ||
167 | 216 | ||
168 | -- | \"q\" = \"ping\" | 217 | -- | \"q\" = \"ping\" |
169 | instance KRPC (Query Ping) (Response Ping) where | 218 | instance KRPC (Query Ping) (Response Ping) where |
219 | #ifdef VERSION_bencoding | ||
170 | method = "ping" | 220 | method = "ping" |
221 | #else | ||
222 | method = Method Tox.Ping -- response: Tox.Pong | ||
223 | #endif | ||
171 | 224 | ||
172 | {----------------------------------------------------------------------- | 225 | {----------------------------------------------------------------------- |
173 | -- find_node method | 226 | -- find_node method |
@@ -175,21 +228,41 @@ instance KRPC (Query Ping) (Response Ping) where | |||
175 | 228 | ||
176 | -- | Find node is used to find the contact information for a node | 229 | -- | Find node is used to find the contact information for a node |
177 | -- given its ID. | 230 | -- given its ID. |
231 | #ifdef VERSION_bencoding | ||
178 | newtype FindNode = FindNode NodeId | 232 | newtype FindNode = FindNode NodeId |
233 | #else | ||
234 | data FindNode = FindNode NodeId Tox.Nonce8 -- Tox: Get Nodes | ||
235 | #endif | ||
179 | deriving (Show, Eq, Typeable) | 236 | deriving (Show, Eq, Typeable) |
180 | 237 | ||
181 | target_key :: BKey | 238 | target_key :: BKey |
182 | target_key = "target" | 239 | target_key = "target" |
183 | 240 | ||
241 | #ifdef VERSION_bencoding | ||
184 | instance BEncode FindNode where | 242 | instance BEncode FindNode where |
185 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict | 243 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict |
186 | fromBEncode = fromDict $ FindNode <$>! target_key | 244 | fromBEncode = fromDict $ FindNode <$>! target_key |
245 | #else | ||
246 | instance Serialize (Query FindNode) where | ||
247 | get = do | ||
248 | nid <- get | ||
249 | nonce <- get | ||
250 | return $ Query (FindNode nid nonce) | ||
251 | put (Query (FindNode nid nonce)) = do | ||
252 | put nid | ||
253 | put nonce | ||
254 | #endif | ||
187 | 255 | ||
188 | -- | When a node receives a 'FindNode' query, it should respond with a | 256 | -- | When a node receives a 'FindNode' query, it should respond with a |
189 | -- the compact node info for the target node or the K (8) closest good | 257 | -- the compact node info for the target node or the K (8) closest good |
190 | -- nodes in its own routing table. | 258 | -- nodes in its own routing table. |
191 | -- | 259 | -- |
260 | #ifdef VERSION_bencoding | ||
192 | newtype NodeFound ip = NodeFound [NodeInfo ip] | 261 | newtype NodeFound ip = NodeFound [NodeInfo ip] |
262 | #else | ||
263 | data NodeFound ip = NodeFound [Tox.NodeFormat] Tox.Nonce8 | ||
264 | #endif | ||
265 | -- Tox: send_nodes | ||
193 | deriving (Show, Eq, Typeable) | 266 | deriving (Show, Eq, Typeable) |
194 | 267 | ||
195 | nodes_key :: BKey | 268 | nodes_key :: BKey |
@@ -200,6 +273,7 @@ from4 :: forall s. Address s => NodeInfo IPv4 -> Either String (NodeInfo s) | |||
200 | from4 n = maybe (Left "Error converting IPv4") Right | 273 | from4 n = maybe (Left "Error converting IPv4") Right |
201 | $ traverse (fromAddr :: IPv4 -> Maybe s) n | 274 | $ traverse (fromAddr :: IPv4 -> Maybe s) n |
202 | 275 | ||
276 | #ifdef VERSION_bencoding | ||
203 | binary :: Serialize a => BKey -> BE.Get [a] | 277 | binary :: Serialize a => BKey -> BE.Get [a] |
204 | binary k = field (req k) >>= either (fail . format) return . | 278 | binary k = field (req k) >>= either (fail . format) return . |
205 | runGet (many get) | 279 | runGet (many get) |
@@ -213,12 +287,31 @@ instance Address ip => BEncode (NodeFound ip) where | |||
213 | 287 | ||
214 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) | 288 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) |
215 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) | 289 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) |
290 | #else | ||
291 | instance Serialize (Response (NodeFound ip)) where | ||
292 | get = do | ||
293 | count <- get :: Get Word8 | ||
294 | nodes <- sequence $ replicate (fromIntegral count) get | ||
295 | nonce <- get :: Get Tox.Nonce8 | ||
296 | return $ Response $ NodeFound nodes nonce | ||
297 | |||
298 | put (Response (NodeFound nodes nonce)) = do | ||
299 | put (fromIntegral (length nodes) :: Word8) | ||
300 | mapM_ put nodes | ||
301 | put nonce | ||
302 | |||
303 | #endif | ||
216 | 304 | ||
217 | -- | \"q\" == \"find_node\" | 305 | -- | \"q\" == \"find_node\" |
218 | instance (Address ip, Typeable ip) | 306 | instance (Address ip, Typeable ip) |
219 | => KRPC (Query FindNode) (Response (NodeFound ip)) where | 307 | => KRPC (Query FindNode) (Response (NodeFound ip)) where |
308 | #ifdef VERSION_bencoding | ||
220 | method = "find_node" | 309 | method = "find_node" |
310 | #else | ||
311 | method = Method Tox.GetNodes -- response: Tox.SendNodes | ||
312 | #endif | ||
221 | 313 | ||
314 | #ifdef VERSION_bencoding | ||
222 | {----------------------------------------------------------------------- | 315 | {----------------------------------------------------------------------- |
223 | -- get_peers method | 316 | -- get_peers method |
224 | -----------------------------------------------------------------------} | 317 | -----------------------------------------------------------------------} |
@@ -354,3 +447,6 @@ instance BEncode Announced where | |||
354 | -- | \"q" = \"announce\" | 447 | -- | \"q" = \"announce\" |
355 | instance KRPC (Query Announce) (Response Announced) where | 448 | instance KRPC (Query Announce) (Response Announced) where |
356 | method = "announce_peer" | 449 | method = "announce_peer" |
450 | |||
451 | -- endif VERSION_bencoding | ||
452 | #endif | ||
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index 5345f8b1..c7e48920 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs | |||
@@ -96,7 +96,10 @@ import qualified Network.BitTorrent.DHT.Search as Search | |||
96 | 96 | ||
97 | nodeHandler :: Address ip => KRPC (Query a) (Response b) | 97 | nodeHandler :: Address ip => KRPC (Query a) (Response b) |
98 | => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip | 98 | => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip |
99 | nodeHandler action = handler $ \ sockAddr (Query remoteId read_only q) -> do | 99 | nodeHandler action = handler $ \ sockAddr qry -> do |
100 | let remoteId = queringNodeId qry | ||
101 | read_only = queryIsReadOnly qry | ||
102 | q = queryParams qry | ||
100 | case fromSockAddr sockAddr of | 103 | case fromSockAddr sockAddr of |
101 | Nothing -> throwIO BadAddress | 104 | Nothing -> throwIO BadAddress |
102 | Just naddr -> do | 105 | Just naddr -> do |
@@ -119,6 +122,7 @@ findNodeH :: Address ip => NodeHandler ip | |||
119 | findNodeH = nodeHandler $ \ _ (FindNode nid) -> do | 122 | findNodeH = nodeHandler $ \ _ (FindNode nid) -> do |
120 | NodeFound <$> getClosest nid | 123 | NodeFound <$> getClosest nid |
121 | 124 | ||
125 | #ifdef VERSION_bencoding | ||
122 | -- | Default 'GetPeers' handler. | 126 | -- | Default 'GetPeers' handler. |
123 | getPeersH :: Ord ip => Address ip => NodeHandler ip | 127 | getPeersH :: Ord ip => Address ip => NodeHandler ip |
124 | getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do | 128 | getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do |
@@ -141,6 +145,11 @@ announceH = nodeHandler $ \ naddr @ NodeAddr {..} (Announce {..}) -> do | |||
141 | -- | Includes all default query handlers. | 145 | -- | Includes all default query handlers. |
142 | defaultHandlers :: Ord ip => Address ip => [NodeHandler ip] | 146 | defaultHandlers :: Ord ip => Address ip => [NodeHandler ip] |
143 | defaultHandlers = [pingH, findNodeH, getPeersH, announceH] | 147 | defaultHandlers = [pingH, findNodeH, getPeersH, announceH] |
148 | #else | ||
149 | -- | Includes all default query handlers. | ||
150 | defaultHandlers :: Ord ip => Address ip => [NodeHandler ip] | ||
151 | defaultHandlers = [pingH, findNodeH] | ||
152 | #endif | ||
144 | 153 | ||
145 | {----------------------------------------------------------------------- | 154 | {----------------------------------------------------------------------- |
146 | -- Basic queries | 155 | -- Basic queries |
@@ -165,6 +174,7 @@ findNodeQ key NodeInfo {..} = do | |||
165 | <> T.pack (L.unlines $ L.map ((' ' :) . show . pPrint) closest) | 174 | <> T.pack (L.unlines $ L.map ((' ' :) . show . pPrint) closest) |
166 | return $ Right closest | 175 | return $ Right closest |
167 | 176 | ||
177 | #ifdef VERSION_bencoding | ||
168 | getPeersQ :: Address ip => InfoHash -> Iteration ip PeerAddr | 178 | getPeersQ :: Address ip => InfoHash -> Iteration ip PeerAddr |
169 | getPeersQ topic NodeInfo {..} = do | 179 | getPeersQ topic NodeInfo {..} = do |
170 | GotPeers {..} <- GetPeers topic <@> nodeAddr | 180 | GotPeers {..} <- GetPeers topic <@> nodeAddr |
@@ -184,6 +194,7 @@ announceQ ih p NodeInfo {..} = do | |||
184 | Right _ -> do -- TODO *probably* add to peer cache | 194 | Right _ -> do -- TODO *probably* add to peer cache |
185 | Announced <- Announce False ih Nothing p grantedToken <@> nodeAddr | 195 | Announced <- Announce False ih Nothing p grantedToken <@> nodeAddr |
186 | return (Right [nodeAddr]) | 196 | return (Right [nodeAddr]) |
197 | #endif | ||
187 | 198 | ||
188 | {----------------------------------------------------------------------- | 199 | {----------------------------------------------------------------------- |
189 | -- Iterative queries | 200 | -- Iterative queries |
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index bad783a5..82926b28 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs | |||
@@ -55,6 +55,7 @@ module Network.BitTorrent.DHT.Session | |||
55 | , getTable | 55 | , getTable |
56 | , getClosest | 56 | , getClosest |
57 | 57 | ||
58 | #ifdef VERSION_bencoding | ||
58 | -- ** Peer storage | 59 | -- ** Peer storage |
59 | , insertPeer | 60 | , insertPeer |
60 | , getPeerList | 61 | , getPeerList |
@@ -64,6 +65,7 @@ module Network.BitTorrent.DHT.Session | |||
64 | , savePeerStore | 65 | , savePeerStore |
65 | , mergeSavedPeers | 66 | , mergeSavedPeers |
66 | , allPeers | 67 | , allPeers |
68 | #endif | ||
67 | 69 | ||
68 | -- ** Messaging | 70 | -- ** Messaging |
69 | , queryParallel | 71 | , queryParallel |
@@ -482,6 +484,7 @@ getTimestamp = do | |||
482 | return $ utcTimeToPOSIXSeconds utcTime | 484 | return $ utcTimeToPOSIXSeconds utcTime |
483 | 485 | ||
484 | 486 | ||
487 | #ifdef VERSION_bencoding | ||
485 | -- | Prepare result for 'get_peers' query. | 488 | -- | Prepare result for 'get_peers' query. |
486 | -- | 489 | -- |
487 | -- This operation use 'getClosest' as failback so it may block. | 490 | -- This operation use 'getClosest' as failback so it may block. |
@@ -503,6 +506,8 @@ deleteTopic ih p = do | |||
503 | var <- asks announceInfo | 506 | var <- asks announceInfo |
504 | liftIO $ atomically $ modifyTVar' var (S.delete (ih, p)) | 507 | liftIO $ atomically $ modifyTVar' var (S.delete (ih, p)) |
505 | 508 | ||
509 | #endif | ||
510 | |||
506 | {----------------------------------------------------------------------- | 511 | {----------------------------------------------------------------------- |
507 | -- Messaging | 512 | -- Messaging |
508 | -----------------------------------------------------------------------} | 513 | -----------------------------------------------------------------------} |
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs index 3f71aabe..4c930cbc 100644 --- a/src/Network/BitTorrent/DHT/Token.hs +++ b/src/Network/BitTorrent/DHT/Token.hs | |||
@@ -17,7 +17,7 @@ | |||
17 | -- must be accepted for a reasonable amount of time after they have | 17 | -- must be accepted for a reasonable amount of time after they have |
18 | -- been distributed. | 18 | -- been distributed. |
19 | -- | 19 | -- |
20 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 20 | {-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-} |
21 | module Network.BitTorrent.DHT.Token | 21 | module Network.BitTorrent.DHT.Token |
22 | ( -- * Token | 22 | ( -- * Token |
23 | Token | 23 | Token |
@@ -38,7 +38,9 @@ module Network.BitTorrent.DHT.Token | |||
38 | ) where | 38 | ) where |
39 | 39 | ||
40 | import Control.Monad.State | 40 | import Control.Monad.State |
41 | #ifdef VERSION_bencoding | ||
41 | import Data.BEncode (BEncode) | 42 | import Data.BEncode (BEncode) |
43 | #endif | ||
42 | import Data.ByteString as BS | 44 | import Data.ByteString as BS |
43 | import Data.ByteString.Char8 as B8 | 45 | import Data.ByteString.Char8 as B8 |
44 | import Data.ByteString.Lazy as BL | 46 | import Data.ByteString.Lazy as BL |
@@ -57,7 +59,11 @@ import Network.BitTorrent.Address | |||
57 | 59 | ||
58 | -- | An opaque value. | 60 | -- | An opaque value. |
59 | newtype Token = Token BS.ByteString | 61 | newtype Token = Token BS.ByteString |
60 | deriving (Eq, BEncode, IsString) | 62 | deriving ( Eq, IsString |
63 | #ifdef VERSION_bencoding | ||
64 | , BEncode | ||
65 | #endif | ||
66 | ) | ||
61 | 67 | ||
62 | instance Show Token where | 68 | instance Show Token where |
63 | show (Token bs) = B8.unpack $ Base16.encode bs | 69 | show (Token bs) = B8.unpack $ Base16.encode bs |
diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs index 66de6548..e7f0563b 100644 --- a/src/Network/KRPC/Manager.hs +++ b/src/Network/KRPC/Manager.hs | |||
@@ -55,9 +55,13 @@ import Control.Monad | |||
55 | import Control.Monad.Logger | 55 | import Control.Monad.Logger |
56 | import Control.Monad.Reader | 56 | import Control.Monad.Reader |
57 | import Control.Monad.Trans.Control | 57 | import Control.Monad.Trans.Control |
58 | #ifdef VERSION_bencoding | ||
58 | import Data.BEncode as BE | 59 | import Data.BEncode as BE |
59 | import Data.BEncode.Internal as BE | 60 | import Data.BEncode.Internal as BE |
60 | import Data.BEncode.Pretty (showBEncode) | 61 | import Data.BEncode.Pretty (showBEncode) |
62 | #else | ||
63 | import qualified Data.Tox as Tox | ||
64 | #endif | ||
61 | import qualified Data.ByteString.Base16 as Base16 | 65 | import qualified Data.ByteString.Base16 as Base16 |
62 | import Data.ByteString as BS | 66 | import Data.ByteString as BS |
63 | import Data.ByteString.Char8 as BC | 67 | import Data.ByteString.Char8 as BC |
@@ -67,6 +71,7 @@ import Data.IORef | |||
67 | import Data.List as L | 71 | import Data.List as L |
68 | import Data.Map as M | 72 | import Data.Map as M |
69 | import Data.Monoid | 73 | import Data.Monoid |
74 | import Data.Serialize as S | ||
70 | import Data.Text as T | 75 | import Data.Text as T |
71 | import Data.Text.Encoding as T | 76 | import Data.Text.Encoding as T |
72 | import Data.Tuple | 77 | import Data.Tuple |
@@ -128,10 +133,10 @@ type KResult = Either KError KResponse | |||
128 | 133 | ||
129 | type TransactionCounter = IORef Int | 134 | type TransactionCounter = IORef Int |
130 | type CallId = (TransactionId, SockAddr) | 135 | type CallId = (TransactionId, SockAddr) |
131 | type CallRes = MVar (BValue, KResult) | 136 | type CallRes = MVar (KQueryArgs, KResult) -- (raw response, decoded response) |
132 | type PendingCalls = IORef (Map CallId CallRes) | 137 | type PendingCalls = IORef (Map CallId CallRes) |
133 | 138 | ||
134 | type HandlerBody h = SockAddr -> BValue -> h (BE.Result BValue) | 139 | type HandlerBody h = SockAddr -> KQueryArgs -> h (Either String KQueryArgs) |
135 | 140 | ||
136 | -- | Handler is a function which will be invoked then some /remote/ | 141 | -- | Handler is a function which will be invoked then some /remote/ |
137 | -- node querying /this/ node. | 142 | -- node querying /this/ node. |
@@ -223,8 +228,13 @@ withManager opts addr hs = bracket (newManager opts addr hs) closeManager | |||
223 | -- TODO prettify log messages | 228 | -- TODO prettify log messages |
224 | querySignature :: MethodName -> TransactionId -> SockAddr -> Text | 229 | querySignature :: MethodName -> TransactionId -> SockAddr -> Text |
225 | querySignature name transaction addr = T.concat | 230 | querySignature name transaction addr = T.concat |
231 | #ifdef VERSION_bencoding | ||
226 | [ "&", T.decodeUtf8 name | 232 | [ "&", T.decodeUtf8 name |
227 | , " #", T.decodeUtf8 (Base16.encode transaction) -- T.decodeUtf8 transaction | 233 | , " #", T.decodeUtf8 (Base16.encode transaction) -- T.decodeUtf8 transaction |
234 | #else | ||
235 | [ "&", T.pack (show name) | ||
236 | , " #", T.decodeUtf8 (Base16.encode $ S.encode transaction) | ||
237 | #endif | ||
228 | , " @", T.pack (show addr) | 238 | , " @", T.pack (show addr) |
229 | ] | 239 | ] |
230 | 240 | ||
@@ -243,14 +253,24 @@ data QueryFailure | |||
243 | 253 | ||
244 | instance Exception QueryFailure | 254 | instance Exception QueryFailure |
245 | 255 | ||
256 | #ifdef VERSION_bencoding | ||
246 | sendMessage :: MonadIO m => BEncode a => Socket -> SockAddr -> a -> m () | 257 | sendMessage :: MonadIO m => BEncode a => Socket -> SockAddr -> a -> m () |
247 | sendMessage sock addr a = do | 258 | sendMessage sock addr a = do |
248 | liftIO $ sendManyTo sock (BL.toChunks (BE.encode a)) addr | 259 | liftIO $ sendManyTo sock (BL.toChunks (BE.encode a)) addr |
260 | #else | ||
261 | sendMessage :: MonadIO m => Socket -> SockAddr -> BC.ByteString -> m () | ||
262 | sendMessage sock addr a = do | ||
263 | liftIO $ sendManyTo sock [a] addr | ||
264 | #endif | ||
249 | 265 | ||
250 | genTransactionId :: TransactionCounter -> IO TransactionId | 266 | genTransactionId :: TransactionCounter -> IO TransactionId |
251 | genTransactionId ref = do | 267 | genTransactionId ref = do |
252 | cur <- atomicModifyIORef' ref $ \ cur -> (succ cur, cur) | 268 | cur <- atomicModifyIORef' ref $ \ cur -> (succ cur, cur) |
269 | #ifdef VERSION_bencoding | ||
253 | return $ BC.pack (show cur) | 270 | return $ BC.pack (show cur) |
271 | #else | ||
272 | return $ either (error "failed to create TransactionId") id $ S.decode $ BC.pack (L.take 24 $ show cur ++ L.repeat ' ') | ||
273 | #endif | ||
254 | 274 | ||
255 | -- | How many times 'query' call have been performed. | 275 | -- | How many times 'query' call have been performed. |
256 | getQueryCount :: MonadKRPC h m => m Int | 276 | getQueryCount :: MonadKRPC h m => m Int |
@@ -274,8 +294,13 @@ unregisterQuery cid ref = do | |||
274 | 294 | ||
275 | 295 | ||
276 | -- (sendmsg EINVAL) | 296 | -- (sendmsg EINVAL) |
297 | #ifdef VERSION_bencoding | ||
277 | sendQuery :: BEncode a => Socket -> SockAddr -> a -> IO () | 298 | sendQuery :: BEncode a => Socket -> SockAddr -> a -> IO () |
278 | sendQuery sock addr q = handle sockError $ sendMessage sock addr q | 299 | sendQuery sock addr q = handle sockError $ sendMessage sock addr q |
300 | #else | ||
301 | sendQuery :: Serialize a => Socket -> SockAddr -> a -> IO () | ||
302 | sendQuery sock addr q = handle sockError $ sendMessage sock addr (S.encode q) | ||
303 | #endif | ||
279 | where | 304 | where |
280 | sockError :: IOError -> IO () | 305 | sockError :: IOError -> IO () |
281 | sockError _ = throwIO SendFailed | 306 | sockError _ = throwIO SendFailed |
@@ -295,11 +320,11 @@ query' addr params = queryK addr params (const (,)) | |||
295 | -- | Enqueue a query, but give us the complete BEncoded content sent by the | 320 | -- | Enqueue a query, but give us the complete BEncoded content sent by the |
296 | -- remote Node. This is useful for handling extensions that this library does | 321 | -- remote Node. This is useful for handling extensions that this library does |
297 | -- not otherwise support. | 322 | -- not otherwise support. |
298 | queryRaw :: forall h m a b. (MonadKRPC h m, KRPC a b) => SockAddr -> a -> m (b, BValue) | 323 | queryRaw :: forall h m a b. (MonadKRPC h m, KRPC a b) => SockAddr -> a -> m (b, KQueryArgs) |
299 | queryRaw addr params = queryK addr params (\raw x _ -> (x,raw)) | 324 | queryRaw addr params = queryK addr params (\raw x _ -> (x,raw)) |
300 | 325 | ||
301 | queryK :: forall h m a b x. (MonadKRPC h m, KRPC a b) => | 326 | queryK :: forall h m a b x. (MonadKRPC h m, KRPC a b) => |
302 | SockAddr -> a -> (BValue -> b -> Maybe ReflectedIP -> x) -> m x | 327 | SockAddr -> a -> (KQueryArgs -> b -> Maybe ReflectedIP -> x) -> m x |
303 | queryK addr params kont = do | 328 | queryK addr params kont = do |
304 | Manager {..} <- getManager | 329 | Manager {..} <- getManager |
305 | tid <- liftIO $ genTransactionId transactionCounter | 330 | tid <- liftIO $ genTransactionId transactionCounter |
@@ -310,17 +335,29 @@ queryK addr params kont = do | |||
310 | mres <- liftIO $ do | 335 | mres <- liftIO $ do |
311 | ares <- registerQuery (tid, addr) pendingCalls | 336 | ares <- registerQuery (tid, addr) pendingCalls |
312 | 337 | ||
338 | #ifdef VERSION_bencoding | ||
313 | let q = KQuery (toBEncode params) (methodName queryMethod) tid | 339 | let q = KQuery (toBEncode params) (methodName queryMethod) tid |
340 | #else | ||
341 | let q = Tox.Message (methodName queryMethod) cli tid params | ||
342 | cli = error "TODO TOX client node id" | ||
343 | #endif | ||
314 | sendQuery sock addr q | 344 | sendQuery sock addr q |
315 | `onException` unregisterQuery (tid, addr) pendingCalls | 345 | `onException` unregisterQuery (tid, addr) pendingCalls |
316 | 346 | ||
317 | timeout (optQueryTimeout options * 10 ^ (6 :: Int)) $ do | 347 | timeout (optQueryTimeout options * 10 ^ (6 :: Int)) $ do |
318 | (raw,res) <- readMVar ares | 348 | (raw,res) <- readMVar ares -- MVar (KQueryArgs, KResult) |
319 | case res of | 349 | case res of |
350 | #ifdef VERSION_bencoding | ||
320 | Left (KError c m _) -> throwIO $ QueryFailed c (T.decodeUtf8 m) | 351 | Left (KError c m _) -> throwIO $ QueryFailed c (T.decodeUtf8 m) |
321 | Right (KResponse {..}) -> | 352 | Right (KResponse {..}) -> |
322 | case fromBEncode respVals of | 353 | case fromBEncode respVals of |
323 | Right r -> pure $ kont raw r respIP | 354 | Right r -> pure $ kont raw r respIP |
355 | #else | ||
356 | Left _ -> throwIO $ QueryFailed GenericError "TODO: TOX ERROR" | ||
357 | Right (Tox.Message {..}) -> | ||
358 | case S.decode msgPayload of | ||
359 | Right r -> pure $ kont raw r Nothing | ||
360 | #endif | ||
324 | Left e -> throwIO $ QueryFailed ProtocolError (T.pack e) | 361 | Left e -> throwIO $ QueryFailed ProtocolError (T.pack e) |
325 | 362 | ||
326 | case mres of | 363 | case mres of |
@@ -377,51 +414,87 @@ handler body = (name, wrapper) | |||
377 | where | 414 | where |
378 | Method name = method :: Method a b | 415 | Method name = method :: Method a b |
379 | wrapper addr args = | 416 | wrapper addr args = |
417 | #ifdef VERSION_bencoding | ||
380 | case fromBEncode args of | 418 | case fromBEncode args of |
419 | #else | ||
420 | case S.decode args of | ||
421 | #endif | ||
381 | Left e -> return $ Left e | 422 | Left e -> return $ Left e |
382 | Right a -> do | 423 | Right a -> do |
383 | r <- body addr a | 424 | r <- body addr a |
425 | #ifdef VERSION_bencoding | ||
384 | return $ Right $ toBEncode r | 426 | return $ Right $ toBEncode r |
427 | #else | ||
428 | return $ Right $ S.encode r | ||
429 | #endif | ||
385 | 430 | ||
386 | runHandler :: MonadKRPC h m | 431 | runHandler :: MonadKRPC h m |
387 | => HandlerBody h -> SockAddr -> KQuery -> m KResult | 432 | => HandlerBody h -> SockAddr -> KQuery -> m KResult |
388 | runHandler h addr KQuery {..} = Lifted.catches wrapper failbacks | 433 | runHandler h addr m = Lifted.catches wrapper failbacks |
389 | where | 434 | where |
390 | signature = querySignature queryMethod queryId addr | 435 | signature = querySignature (queryMethod m) (queryId m) addr |
391 | 436 | ||
392 | wrapper = do | 437 | wrapper = do |
393 | $(logDebugS) "handler.quered" signature | 438 | $(logDebugS) "handler.quered" signature |
394 | result <- liftHandler (h addr queryArgs) | 439 | result <- liftHandler (h addr (queryArgs m)) |
395 | 440 | ||
396 | case result of | 441 | case result of |
397 | Left msg -> do | 442 | Left msg -> do |
398 | $(logDebugS) "handler.bad_query" $ signature <> " !" <> T.pack msg | 443 | $(logDebugS) "handler.bad_query" $ signature <> " !" <> T.pack msg |
399 | return $ Left $ KError ProtocolError (BC.pack msg) queryId | 444 | #ifdef VERSION_bencoding |
445 | return $ Left $ KError ProtocolError (BC.pack msg) (queryId m) | ||
446 | #else | ||
447 | return $ Left $ decodeError "TODO TOX ProtocolError" (queryId m) | ||
448 | #endif | ||
400 | 449 | ||
401 | Right a -> do | 450 | Right a -> do -- KQueryArgs |
402 | $(logDebugS) "handler.success" signature | 451 | $(logDebugS) "handler.success" signature |
403 | return $ Right $ KResponse a queryId (Just $ ReflectedIP addr) | 452 | #ifdef VERSION_bencoding |
453 | return $ Right $ KResponse a (queryId m) (Just $ ReflectedIP addr) | ||
454 | #else | ||
455 | let cli = error "TODO TOX client node id" | ||
456 | messageid = error "TODO TOX message response id" | ||
457 | -- TODO: ReflectedIP addr ?? | ||
458 | return $ Right $ Tox.Message messageid cli (queryId m) a | ||
459 | #endif | ||
404 | 460 | ||
405 | failbacks = | 461 | failbacks = |
406 | [ E.Handler $ \ (e :: HandlerFailure) -> do | 462 | [ E.Handler $ \ (e :: HandlerFailure) -> do |
407 | $(logDebugS) "handler.failed" signature | 463 | $(logDebugS) "handler.failed" signature |
408 | return $ Left $ KError ProtocolError (prettyHF e) queryId | 464 | #ifdef VERSION_bencoding |
465 | return $ Left $ KError ProtocolError (prettyHF e) (queryId m) | ||
466 | #else | ||
467 | return $ Left $ decodeError "TODO TOX ProtocolError 2" (queryId m) | ||
468 | #endif | ||
469 | |||
409 | 470 | ||
410 | -- may happen if handler makes query and fail | 471 | -- may happen if handler makes query and fail |
411 | , E.Handler $ \ (e :: QueryFailure) -> do | 472 | , E.Handler $ \ (e :: QueryFailure) -> do |
412 | return $ Left $ KError ServerError (prettyQF e) queryId | 473 | #ifdef VERSION_bencoding |
474 | return $ Left $ KError ServerError (prettyQF e) (queryId m) | ||
475 | #else | ||
476 | return $ Left $ decodeError "TODO TOX ServerError" (queryId m) | ||
477 | #endif | ||
413 | 478 | ||
414 | -- since handler thread exit after sendMessage we can safely | 479 | -- since handler thread exit after sendMessage we can safely |
415 | -- suppress async exception here | 480 | -- suppress async exception here |
416 | , E.Handler $ \ (e :: SomeException) -> do | 481 | , E.Handler $ \ (e :: SomeException) -> do |
417 | return $ Left $ KError GenericError (BC.pack (show e)) queryId | 482 | #ifdef VERSION_bencoding |
483 | return $ Left $ KError GenericError (BC.pack (show e)) (queryId m) | ||
484 | #else | ||
485 | return $ Left $ decodeError "TODO TOX GenericError" (queryId m) | ||
486 | #endif | ||
418 | ] | 487 | ] |
419 | 488 | ||
420 | dispatchHandler :: MonadKRPC h m => KQuery -> SockAddr -> m KResult | 489 | dispatchHandler :: MonadKRPC h m => KQuery -> SockAddr -> m KResult |
421 | dispatchHandler q @ KQuery {..} addr = do | 490 | dispatchHandler q addr = do |
422 | Manager {..} <- getManager | 491 | Manager {..} <- getManager |
423 | case L.lookup queryMethod handlers of | 492 | case L.lookup (queryMethod q) handlers of |
424 | Nothing -> return $ Left $ KError MethodUnknown queryMethod queryId | 493 | #ifdef VERSION_bencoding |
494 | Nothing -> return $ Left $ KError MethodUnknown (queryMethod q) (queryId q) | ||
495 | #else | ||
496 | Nothing -> return $ Left $ decodeError "TODO TOX Error MethodUnknown" (queryId q) | ||
497 | #endif | ||
425 | Just h -> runHandler h addr q | 498 | Just h -> runHandler h addr q |
426 | 499 | ||
427 | {----------------------------------------------------------------------- | 500 | {----------------------------------------------------------------------- |
@@ -435,11 +508,12 @@ dispatchHandler q @ KQuery {..} addr = do | |||
435 | -- peer B fork too many threads | 508 | -- peer B fork too many threads |
436 | -- ... space leak | 509 | -- ... space leak |
437 | -- | 510 | -- |
438 | handleQuery :: MonadKRPC h m => BValue -> KQuery -> SockAddr -> m () | 511 | handleQuery :: MonadKRPC h m => KQueryArgs -> KQuery -> SockAddr -> m () |
439 | handleQuery raw q addr = void $ fork $ do | 512 | handleQuery raw q addr = void $ fork $ do |
440 | myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" | 513 | myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" |
441 | Manager {..} <- getManager | 514 | Manager {..} <- getManager |
442 | res <- dispatchHandler q addr | 515 | res <- dispatchHandler q addr |
516 | #ifdef VERSION_bencoding | ||
443 | let resbe = either toBEncode toBEncode res | 517 | let resbe = either toBEncode toBEncode res |
444 | $(logOther "q") $ T.unlines | 518 | $(logOther "q") $ T.unlines |
445 | [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw) | 519 | [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw) |
@@ -447,21 +521,36 @@ handleQuery raw q addr = void $ fork $ do | |||
447 | , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) | 521 | , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) |
448 | ] | 522 | ] |
449 | sendMessage sock addr resbe | 523 | sendMessage sock addr resbe |
524 | #else | ||
525 | -- Errors not sent for Tox. | ||
526 | either (const $ return ()) (sendMessage sock addr . S.encode) res | ||
527 | #endif | ||
450 | 528 | ||
451 | handleResponse :: MonadKRPC h m => BValue -> KResult -> SockAddr -> m () | 529 | handleResponse :: MonadKRPC h m => KQueryArgs -> KResult -> SockAddr -> m () |
452 | handleResponse raw result addr = do | 530 | handleResponse raw result addr = do |
453 | Manager {..} <- getManager | 531 | Manager {..} <- getManager |
454 | liftIO $ do | 532 | liftIO $ do |
533 | #ifdef VERSION_bencoding | ||
455 | let resultId = either errorId respId result | 534 | let resultId = either errorId respId result |
535 | #else | ||
536 | let resultId = either Tox.msgNonce Tox.msgNonce result | ||
537 | #endif | ||
456 | mcall <- unregisterQuery (resultId, addr) pendingCalls | 538 | mcall <- unregisterQuery (resultId, addr) pendingCalls |
457 | case mcall of | 539 | case mcall of |
458 | Nothing -> return () | 540 | Nothing -> return () |
459 | Just ares -> putMVar ares (raw,result) | 541 | Just ares -> putMVar ares (raw,result) |
460 | 542 | ||
461 | handleMessage :: MonadKRPC h m => BValue -> KMessage -> SockAddr -> m () | 543 | #ifdef VERSION_bencoding |
544 | handleMessage :: MonadKRPC h m => KQueryArgs -> KMessage -> SockAddr -> m () | ||
462 | handleMessage raw (Q q) = handleQuery raw q | 545 | handleMessage raw (Q q) = handleQuery raw q |
463 | handleMessage raw (R r) = handleResponse raw (Right r) | 546 | handleMessage raw (R r) = handleResponse raw (Right r) |
464 | handleMessage raw (E e) = handleResponse raw (Left e) | 547 | handleMessage raw (E e) = handleResponse raw (Left e) |
548 | #else | ||
549 | handleMessage :: MonadKRPC h m => KQueryArgs -> Tox.Message BC.ByteString -> SockAddr -> m () | ||
550 | handleMessage raw q | Tox.isQuery q = handleQuery raw q | ||
551 | handleMessage raw r | Tox.isResponse r = handleResponse raw (Right r) | ||
552 | handleMessage raw e | Tox.isError e = handleResponse raw (Left e) | ||
553 | #endif | ||
465 | 554 | ||
466 | listener :: MonadKRPC h m => m () | 555 | listener :: MonadKRPC h m => m () |
467 | listener = do | 556 | listener = do |
@@ -469,9 +558,17 @@ listener = do | |||
469 | fix $ \again -> do | 558 | fix $ \again -> do |
470 | (bs, addr) <- liftIO $ do | 559 | (bs, addr) <- liftIO $ do |
471 | handle exceptions $ BS.recvFrom sock (optMaxMsgSize options) | 560 | handle exceptions $ BS.recvFrom sock (optMaxMsgSize options) |
561 | #ifdef VERSION_bencoding | ||
472 | case BE.parse bs >>= \r -> (,) r <$> BE.decode bs of | 562 | case BE.parse bs >>= \r -> (,) r <$> BE.decode bs of |
563 | #else | ||
564 | case return bs >>= \r -> (,) r <$> decode bs of | ||
565 | #endif | ||
473 | -- TODO ignore unknown messages at all? | 566 | -- TODO ignore unknown messages at all? |
567 | #ifdef VERSION_bencoding | ||
474 | Left e -> liftIO $ sendMessage sock addr $ unknownMessage e | 568 | Left e -> liftIO $ sendMessage sock addr $ unknownMessage e |
569 | #else | ||
570 | Left _ -> return () -- TODO TOX send unknownMessage error | ||
571 | #endif | ||
475 | Right (raw,m) -> handleMessage raw m addr | 572 | Right (raw,m) -> handleMessage raw m addr |
476 | again | 573 | again |
477 | where | 574 | where |
diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs index 6f4ae620..d48fa8ac 100644 --- a/src/Network/KRPC/Message.hs +++ b/src/Network/KRPC/Message.hs | |||
@@ -12,8 +12,10 @@ | |||
12 | -- | 12 | -- |
13 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> | 13 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> |
14 | -- | 14 | -- |
15 | {-# LANGUAGE CPP #-} | ||
15 | {-# LANGUAGE OverloadedStrings #-} | 16 | {-# LANGUAGE OverloadedStrings #-} |
16 | {-# LANGUAGE FlexibleContexts #-} | 17 | {-# LANGUAGE FlexibleContexts #-} |
18 | {-# LANGUAGE FlexibleInstances #-} | ||
17 | {-# LANGUAGE TypeSynonymInstances #-} | 19 | {-# LANGUAGE TypeSynonymInstances #-} |
18 | {-# LANGUAGE MultiParamTypeClasses #-} | 20 | {-# LANGUAGE MultiParamTypeClasses #-} |
19 | {-# LANGUAGE FunctionalDependencies #-} | 21 | {-# LANGUAGE FunctionalDependencies #-} |
@@ -31,6 +33,11 @@ module Network.KRPC.Message | |||
31 | 33 | ||
32 | -- * Query | 34 | -- * Query |
33 | , KQuery(..) | 35 | , KQuery(..) |
36 | #ifndef VERSION_bencoding | ||
37 | , queryArgs | ||
38 | , queryMethod | ||
39 | , queryId | ||
40 | #endif | ||
34 | , MethodName | 41 | , MethodName |
35 | 42 | ||
36 | -- * Response | 43 | -- * Response |
@@ -39,12 +46,18 @@ module Network.KRPC.Message | |||
39 | 46 | ||
40 | -- * Message | 47 | -- * Message |
41 | , KMessage (..) | 48 | , KMessage (..) |
49 | , KQueryArgs | ||
50 | |||
42 | ) where | 51 | ) where |
43 | 52 | ||
44 | import Control.Applicative | 53 | import Control.Applicative |
45 | import Control.Arrow | 54 | import Control.Arrow |
46 | import Control.Exception.Lifted as Lifted | 55 | import Control.Exception.Lifted as Lifted |
56 | #ifdef VERSION_bencoding | ||
47 | import Data.BEncode as BE | 57 | import Data.BEncode as BE |
58 | #else | ||
59 | import qualified Data.Tox as Tox | ||
60 | #endif | ||
48 | import Data.ByteString as B | 61 | import Data.ByteString as B |
49 | import Data.ByteString.Char8 as BC | 62 | import Data.ByteString.Char8 as BC |
50 | import qualified Data.Serialize as S | 63 | import qualified Data.Serialize as S |
@@ -53,15 +66,23 @@ import Data.Typeable | |||
53 | import Network.Socket (SockAddr (..),PortNumber,HostAddress) | 66 | import Network.Socket (SockAddr (..),PortNumber,HostAddress) |
54 | 67 | ||
55 | 68 | ||
69 | #ifdef VERSION_bencoding | ||
56 | -- | This transaction ID is generated by the querying node and is | 70 | -- | This transaction ID is generated by the querying node and is |
57 | -- echoed in the response, so responses may be correlated with | 71 | -- echoed in the response, so responses may be correlated with |
58 | -- multiple queries to the same node. The transaction ID should be | 72 | -- multiple queries to the same node. The transaction ID should be |
59 | -- encoded as a short string of binary numbers, typically 2 characters | 73 | -- encoded as a short string of binary numbers, typically 2 characters |
60 | -- are enough as they cover 2^16 outstanding queries. | 74 | -- are enough as they cover 2^16 outstanding queries. |
61 | type TransactionId = ByteString | 75 | type TransactionId = ByteString |
76 | #else | ||
77 | type TransactionId = Tox.Nonce24 -- msgNonce | ||
78 | #endif | ||
62 | 79 | ||
63 | unknownTransaction :: TransactionId | 80 | unknownTransaction :: TransactionId |
81 | #ifdef VERSION_bencoding | ||
64 | unknownTransaction = "" | 82 | unknownTransaction = "" |
83 | #else | ||
84 | unknownTransaction = 0 | ||
85 | #endif | ||
65 | 86 | ||
66 | {----------------------------------------------------------------------- | 87 | {----------------------------------------------------------------------- |
67 | -- Error messages | 88 | -- Error messages |
@@ -98,13 +119,16 @@ instance Enum ErrorCode where | |||
98 | toEnum _ = GenericError | 119 | toEnum _ = GenericError |
99 | {-# INLINE toEnum #-} | 120 | {-# INLINE toEnum #-} |
100 | 121 | ||
122 | #ifdef VERSION_bencoding | ||
101 | instance BEncode ErrorCode where | 123 | instance BEncode ErrorCode where |
102 | toBEncode = toBEncode . fromEnum | 124 | toBEncode = toBEncode . fromEnum |
103 | {-# INLINE toBEncode #-} | 125 | {-# INLINE toBEncode #-} |
104 | 126 | ||
105 | fromBEncode b = toEnum <$> fromBEncode b | 127 | fromBEncode b = toEnum <$> fromBEncode b |
106 | {-# INLINE fromBEncode #-} | 128 | {-# INLINE fromBEncode #-} |
129 | #endif | ||
107 | 130 | ||
131 | #ifdef VERSION_bencoding | ||
108 | -- | Errors are sent when a query cannot be fulfilled. Error message | 132 | -- | Errors are sent when a query cannot be fulfilled. Error message |
109 | -- can be send only from server to client but not in the opposite | 133 | -- can be send only from server to client but not in the opposite |
110 | -- direction. | 134 | -- direction. |
@@ -113,7 +137,10 @@ data KError = KError | |||
113 | { errorCode :: !ErrorCode -- ^ the type of error; | 137 | { errorCode :: !ErrorCode -- ^ the type of error; |
114 | , errorMessage :: !ByteString -- ^ human-readable text message; | 138 | , errorMessage :: !ByteString -- ^ human-readable text message; |
115 | , errorId :: !TransactionId -- ^ match to the corresponding 'queryId'. | 139 | , errorId :: !TransactionId -- ^ match to the corresponding 'queryId'. |
116 | } deriving (Show, Read, Eq, Ord, Typeable) | 140 | } deriving ( Show, Eq, Ord, Typeable, Read ) |
141 | #else | ||
142 | type KError = Tox.Message ByteString -- TODO TOX unused | ||
143 | #endif | ||
117 | 144 | ||
118 | -- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\", | 145 | -- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\", |
119 | -- contain one additional key \"e\". The value of \"e\" is a | 146 | -- contain one additional key \"e\". The value of \"e\" is a |
@@ -129,6 +156,7 @@ data KError = KError | |||
129 | -- | 156 | -- |
130 | -- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee | 157 | -- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee |
131 | -- | 158 | -- |
159 | #ifdef VERSION_bencoding | ||
132 | instance BEncode KError where | 160 | instance BEncode KError where |
133 | toBEncode KError {..} = toDict $ | 161 | toBEncode KError {..} = toDict $ |
134 | "e" .=! (errorCode, errorMessage) | 162 | "e" .=! (errorCode, errorMessage) |
@@ -142,33 +170,49 @@ instance BEncode KError where | |||
142 | (code, msg) <- field (req "e") | 170 | (code, msg) <- field (req "e") |
143 | KError code msg <$>! "t" | 171 | KError code msg <$>! "t" |
144 | {-# INLINE fromBEncode #-} | 172 | {-# INLINE fromBEncode #-} |
173 | #endif | ||
145 | 174 | ||
146 | instance Exception KError | 175 | instance Exception KError |
147 | 176 | ||
148 | -- | Received 'queryArgs' or 'respVals' can not be decoded. | 177 | -- | Received 'queryArgs' or 'respVals' can not be decoded. |
149 | decodeError :: String -> TransactionId -> KError | 178 | decodeError :: String -> TransactionId -> KError |
179 | #ifdef VERSION_bencoding | ||
150 | decodeError msg = KError ProtocolError (BC.pack msg) | 180 | decodeError msg = KError ProtocolError (BC.pack msg) |
181 | #else | ||
182 | decodeError msg = error "TODO TOX Error packet" | ||
183 | #endif | ||
151 | 184 | ||
152 | -- | A remote node has send some 'KMessage' this node is unable to | 185 | -- | A remote node has send some 'KMessage' this node is unable to |
153 | -- decode. | 186 | -- decode. |
154 | unknownMessage :: String -> KError | 187 | unknownMessage :: String -> KError |
188 | #ifdef VERSION_bencoding | ||
155 | unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction | 189 | unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction |
190 | #else | ||
191 | unknownMessage msg = error "TODO TOX Protocol error" | ||
192 | #endif | ||
156 | 193 | ||
157 | {----------------------------------------------------------------------- | 194 | {----------------------------------------------------------------------- |
158 | -- Query messages | 195 | -- Query messages |
159 | -----------------------------------------------------------------------} | 196 | -----------------------------------------------------------------------} |
160 | 197 | ||
198 | #ifdef VERSION_bencoding | ||
161 | type MethodName = ByteString | 199 | type MethodName = ByteString |
200 | type KQueryArgs = BValue | ||
201 | #else | ||
202 | type MethodName = Tox.MessageType -- msgType | ||
203 | type KQueryArgs = ByteString -- msgPayload | ||
204 | #endif | ||
162 | 205 | ||
206 | #ifdef VERSION_bencoding | ||
163 | -- | Query used to signal that caller want to make procedure call to | 207 | -- | Query used to signal that caller want to make procedure call to |
164 | -- callee and pass arguments in. Therefore query may be only sent from | 208 | -- callee and pass arguments in. Therefore query may be only sent from |
165 | -- client to server but not in the opposite direction. | 209 | -- client to server but not in the opposite direction. |
166 | -- | 210 | -- |
167 | data KQuery = KQuery | 211 | data KQuery = KQuery |
168 | { queryArgs :: !BValue -- ^ values to be passed to method; | 212 | { queryArgs :: !KQueryArgs -- ^ values to be passed to method; |
169 | , queryMethod :: !MethodName -- ^ method to call; | 213 | , queryMethod :: !MethodName -- ^ method to call; |
170 | , queryId :: !TransactionId -- ^ one-time query token. | 214 | , queryId :: !TransactionId -- ^ one-time query token. |
171 | } deriving (Show, Read, Eq, Ord, Typeable) | 215 | } deriving ( Show, Eq, Ord, Typeable, Read ) |
172 | 216 | ||
173 | -- | Queries, or KRPC message dictionaries with a \"y\" value of | 217 | -- | Queries, or KRPC message dictionaries with a \"y\" value of |
174 | -- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has | 218 | -- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has |
@@ -193,13 +237,19 @@ instance BEncode KQuery where | |||
193 | KQuery <$>! "a" <*>! "q" <*>! "t" | 237 | KQuery <$>! "a" <*>! "q" <*>! "t" |
194 | {-# INLINE fromBEncode #-} | 238 | {-# INLINE fromBEncode #-} |
195 | 239 | ||
196 | newtype ReflectedIP = ReflectedIP SockAddr | ||
197 | deriving (Eq, Ord, Show) | ||
198 | |||
199 | instance BEncode ReflectedIP where | 240 | instance BEncode ReflectedIP where |
200 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) | 241 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) |
201 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs | 242 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs |
202 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" | 243 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" |
244 | #else | ||
245 | type KQuery = Tox.Message KQueryArgs | ||
246 | queryArgs = Tox.msgPayload | ||
247 | queryMethod = Tox.msgType | ||
248 | queryId = Tox.msgNonce | ||
249 | #endif | ||
250 | |||
251 | newtype ReflectedIP = ReflectedIP SockAddr | ||
252 | deriving (Eq, Ord, Show) | ||
203 | 253 | ||
204 | port16 :: Word16 -> PortNumber | 254 | port16 :: Word16 -> PortNumber |
205 | port16 = fromIntegral | 255 | port16 = fromIntegral |
@@ -237,8 +287,9 @@ encodeAddr _ = B.empty | |||
237 | -- | 287 | -- |
238 | -- * KResponse can be only sent from server to client. | 288 | -- * KResponse can be only sent from server to client. |
239 | -- | 289 | -- |
290 | #ifdef VERSION_bencoding | ||
240 | data KResponse = KResponse | 291 | data KResponse = KResponse |
241 | { respVals :: BValue -- ^ 'BDict' containing return values; | 292 | { respVals :: KQueryArgs -- ^ 'BDict' containing return values; |
242 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. | 293 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. |
243 | , respIP :: Maybe ReflectedIP | 294 | , respIP :: Maybe ReflectedIP |
244 | } deriving (Show, Eq, Ord, Typeable) | 295 | } deriving (Show, Eq, Ord, Typeable) |
@@ -265,11 +316,18 @@ instance BEncode KResponse where | |||
265 | addr <- optional (field (req "ip")) | 316 | addr <- optional (field (req "ip")) |
266 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" | 317 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" |
267 | {-# INLINE fromBEncode #-} | 318 | {-# INLINE fromBEncode #-} |
319 | #else | ||
320 | type KResponse = Tox.Message KQueryArgs | ||
321 | respVals = Tox.msgPayload | ||
322 | respId = Tox.msgNonce | ||
323 | respIP = Nothing :: Maybe ReflectedIP | ||
324 | #endif | ||
268 | 325 | ||
269 | {----------------------------------------------------------------------- | 326 | {----------------------------------------------------------------------- |
270 | -- Summed messages | 327 | -- Summed messages |
271 | -----------------------------------------------------------------------} | 328 | -----------------------------------------------------------------------} |
272 | 329 | ||
330 | #ifdef VERSION_bencoding | ||
273 | -- | Generic KRPC message. | 331 | -- | Generic KRPC message. |
274 | data KMessage | 332 | data KMessage |
275 | = Q KQuery | 333 | = Q KQuery |
@@ -287,3 +345,6 @@ instance BEncode KMessage where | |||
287 | <|> R <$> fromBEncode b | 345 | <|> R <$> fromBEncode b |
288 | <|> E <$> fromBEncode b | 346 | <|> E <$> fromBEncode b |
289 | <|> decodingError "KMessage: unknown message or message tag" | 347 | <|> decodingError "KMessage: unknown message or message tag" |
348 | #else | ||
349 | type KMessage = Tox.Message | ||
350 | #endif | ||
diff --git a/src/Network/KRPC/Method.hs b/src/Network/KRPC/Method.hs index 916b38a8..2a791924 100644 --- a/src/Network/KRPC/Method.hs +++ b/src/Network/KRPC/Method.hs | |||
@@ -7,6 +7,7 @@ | |||
7 | -- | 7 | -- |
8 | -- Normally, you don't need to import this module. | 8 | -- Normally, you don't need to import this module. |
9 | -- | 9 | -- |
10 | {-# LANGUAGE CPP #-} | ||
10 | {-# LANGUAGE RankNTypes #-} | 11 | {-# LANGUAGE RankNTypes #-} |
11 | {-# LANGUAGE MultiParamTypeClasses #-} | 12 | {-# LANGUAGE MultiParamTypeClasses #-} |
12 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 13 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
@@ -17,7 +18,11 @@ module Network.KRPC.Method | |||
17 | , KRPC (..) | 18 | , KRPC (..) |
18 | ) where | 19 | ) where |
19 | 20 | ||
21 | #ifdef VERSION_bencoding | ||
20 | import Data.BEncode (BEncode) | 22 | import Data.BEncode (BEncode) |
23 | #else | ||
24 | import Data.Serialize | ||
25 | #endif | ||
21 | import Data.ByteString.Char8 as BC | 26 | import Data.ByteString.Char8 as BC |
22 | import Data.Char | 27 | import Data.Char |
23 | import Data.Monoid | 28 | import Data.Monoid |
@@ -38,7 +43,12 @@ import Network.KRPC.Message | |||
38 | -- * result: Type of return value of the method. | 43 | -- * result: Type of return value of the method. |
39 | -- | 44 | -- |
40 | newtype Method param result = Method { methodName :: MethodName } | 45 | newtype Method param result = Method { methodName :: MethodName } |
41 | deriving (Eq, Ord, IsString, BEncode) | 46 | deriving ( Eq, Ord |
47 | #ifdef VERSION_bencoding | ||
48 | , IsString | ||
49 | , BEncode | ||
50 | #endif | ||
51 | ) | ||
42 | 52 | ||
43 | -- | Example: | 53 | -- | Example: |
44 | -- | 54 | -- |
@@ -49,7 +59,11 @@ instance (Typeable a, Typeable b) => Show (Method a b) where | |||
49 | 59 | ||
50 | showsMethod :: forall a b. ( Typeable a , Typeable b ) => Method a b -> ShowS | 60 | showsMethod :: forall a b. ( Typeable a , Typeable b ) => Method a b -> ShowS |
51 | showsMethod (Method name) = | 61 | showsMethod (Method name) = |
62 | #ifdef VERSION_bencoding | ||
52 | showString (BC.unpack name) <> | 63 | showString (BC.unpack name) <> |
64 | #else | ||
65 | shows (show name) <> | ||
66 | #endif | ||
53 | showString " :: " <> | 67 | showString " :: " <> |
54 | shows paramsTy <> | 68 | shows paramsTy <> |
55 | showString " -> " <> | 69 | showString " -> " <> |
@@ -72,7 +86,13 @@ showsMethod (Method name) = | |||
72 | -- method = \"ping\" | 86 | -- method = \"ping\" |
73 | -- @ | 87 | -- @ |
74 | -- | 88 | -- |
75 | class (Typeable req, BEncode req, Typeable resp, BEncode resp) | 89 | class ( Typeable req, Typeable resp |
90 | #ifdef VERSION_bencoding | ||
91 | , BEncode req, BEncode resp | ||
92 | #else | ||
93 | , Serialize req, Serialize resp | ||
94 | #endif | ||
95 | ) | ||
76 | => KRPC req resp where | 96 | => KRPC req resp where |
77 | 97 | ||
78 | -- | Method name. Default implementation uses lowercased @req@ | 98 | -- | Method name. Default implementation uses lowercased @req@ |
@@ -80,8 +100,10 @@ class (Typeable req, BEncode req, Typeable resp, BEncode resp) | |||
80 | -- | 100 | -- |
81 | method :: Method req resp | 101 | method :: Method req resp |
82 | 102 | ||
103 | #ifdef VERSION_bencoding | ||
83 | -- TODO add underscores | 104 | -- TODO add underscores |
84 | default method :: Typeable req => Method req resp | 105 | default method :: Typeable req => Method req resp |
85 | method = Method $ fromString $ L.map toLower $ show $ typeOf hole | 106 | method = Method $ fromString $ L.map toLower $ show $ typeOf hole |
86 | where | 107 | where |
87 | hole = error "krpc.method: impossible" :: req | 108 | hole = error "krpc.method: impossible" :: req |
109 | #endif | ||