summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs29
-rw-r--r--src/Network/BitTorrent/DHT/Query.hs9
-rw-r--r--src/Network/BitTorrent/DHT/Session.hs4
3 files changed, 31 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 44dc9b2f..0e2bfdd9 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -61,6 +61,7 @@
61{-# LANGUAGE MultiParamTypeClasses #-} 61{-# LANGUAGE MultiParamTypeClasses #-}
62{-# LANGUAGE UndecidableInstances #-} 62{-# LANGUAGE UndecidableInstances #-}
63{-# LANGUAGE ScopedTypeVariables #-} 63{-# LANGUAGE ScopedTypeVariables #-}
64{-# LANGUAGE TypeFamilies #-}
64module Network.BitTorrent.DHT.Message 65module Network.BitTorrent.DHT.Message
65 ( -- * Envelopes 66 ( -- * Envelopes
66 Query (..) 67 Query (..)
@@ -217,6 +218,9 @@ instance Serialize (Response Ping) where
217-- | \"q\" = \"ping\" 218-- | \"q\" = \"ping\"
218instance KRPC (Query Ping) (Response Ping) where 219instance KRPC (Query Ping) (Response Ping) where
219#ifdef VERSION_bencoding 220#ifdef VERSION_bencoding
221 type Envelope (Query Ping) (Response Ping) = BValue
222 seal = toBEncode
223 unseal = fromBEncode
220 method = "ping" 224 method = "ping"
221#else 225#else
222 method = Method Tox.Ping -- response: Tox.Pong 226 method = Method Tox.Ping -- response: Tox.Pong
@@ -229,9 +233,9 @@ instance KRPC (Query Ping) (Response Ping) where
229-- | Find node is used to find the contact information for a node 233-- | Find node is used to find the contact information for a node
230-- given its ID. 234-- given its ID.
231#ifdef VERSION_bencoding 235#ifdef VERSION_bencoding
232newtype FindNode = FindNode NodeId 236newtype FindNode ip = FindNode NodeId
233#else 237#else
234data FindNode = FindNode NodeId Tox.Nonce8 -- Tox: Get Nodes 238data FindNode ip = FindNode NodeId Tox.Nonce8 -- Tox: Get Nodes
235#endif 239#endif
236 deriving (Show, Eq, Typeable) 240 deriving (Show, Eq, Typeable)
237 241
@@ -239,11 +243,11 @@ target_key :: BKey
239target_key = "target" 243target_key = "target"
240 244
241#ifdef VERSION_bencoding 245#ifdef VERSION_bencoding
242instance BEncode FindNode where 246instance Typeable ip => BEncode (FindNode ip) where
243 toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict 247 toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict
244 fromBEncode = fromDict $ FindNode <$>! target_key 248 fromBEncode = fromDict $ FindNode <$>! target_key
245#else 249#else
246instance Serialize (Query FindNode) where 250instance Serialize (Query (FindNode ip)) where
247 get = do 251 get = do
248 nid <- get 252 nid <- get
249 nonce <- get 253 nonce <- get
@@ -304,8 +308,11 @@ instance Serialize (Response (NodeFound ip)) where
304 308
305-- | \"q\" == \"find_node\" 309-- | \"q\" == \"find_node\"
306instance (Address ip, Typeable ip) 310instance (Address ip, Typeable ip)
307 => KRPC (Query FindNode) (Response (NodeFound ip)) where 311 => KRPC (Query (FindNode ip)) (Response (NodeFound ip)) where
308#ifdef VERSION_bencoding 312#ifdef VERSION_bencoding
313 type Envelope (Query (FindNode ip)) (Response (NodeFound ip)) = BValue
314 seal = toBEncode
315 unseal = fromBEncode
309 method = "find_node" 316 method = "find_node"
310#else 317#else
311 method = Method Tox.GetNodes -- response: Tox.SendNodes 318 method = Method Tox.GetNodes -- response: Tox.SendNodes
@@ -317,13 +324,13 @@ instance (Address ip, Typeable ip)
317-----------------------------------------------------------------------} 324-----------------------------------------------------------------------}
318 325
319-- | Get peers associated with a torrent infohash. 326-- | Get peers associated with a torrent infohash.
320newtype GetPeers = GetPeers InfoHash 327newtype GetPeers ip = GetPeers InfoHash
321 deriving (Show, Eq, Typeable) 328 deriving (Show, Eq, Typeable)
322 329
323info_hash_key :: BKey 330info_hash_key :: BKey
324info_hash_key = "info_hash" 331info_hash_key = "info_hash"
325 332
326instance BEncode GetPeers where 333instance Typeable ip => BEncode (GetPeers ip) where
327 toBEncode (GetPeers ih) = toDict $ info_hash_key .=! ih .: endDict 334 toBEncode (GetPeers ih) = toDict $ info_hash_key .=! ih .: endDict
328 fromBEncode = fromDict $ GetPeers <$>! info_hash_key 335 fromBEncode = fromDict $ GetPeers <$>! info_hash_key
329 336
@@ -373,7 +380,10 @@ instance (Typeable ip, Serialize ip) => BEncode (GotPeers ip) where
373 380
374-- | \"q" = \"get_peers\" 381-- | \"q" = \"get_peers\"
375instance (Typeable ip, Serialize ip) => 382instance (Typeable ip, Serialize ip) =>
376 KRPC (Query GetPeers) (Response (GotPeers ip)) where 383 KRPC (Query (GetPeers ip)) (Response (GotPeers ip)) where
384 type Envelope (Query (GetPeers ip)) (Response (GotPeers ip)) = BValue
385 seal = toBEncode
386 unseal = fromBEncode
377 method = "get_peers" 387 method = "get_peers"
378 388
379{----------------------------------------------------------------------- 389{-----------------------------------------------------------------------
@@ -446,6 +456,9 @@ instance BEncode Announced where
446 456
447-- | \"q" = \"announce\" 457-- | \"q" = \"announce\"
448instance KRPC (Query Announce) (Response Announced) where 458instance KRPC (Query Announce) (Response Announced) where
459 type Envelope (Query Announce) (Response Announced) = BValue
460 seal = toBEncode
461 unseal = fromBEncode
449 method = "announce_peer" 462 method = "announce_peer"
450 463
451-- endif VERSION_bencoding 464-- endif VERSION_bencoding
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index c7e48920..a1934014 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -14,6 +14,7 @@
14{-# LANGUAGE ScopedTypeVariables #-} 14{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE TemplateHaskell #-} 15{-# LANGUAGE TemplateHaskell #-}
16{-# LANGUAGE TupleSections #-} 16{-# LANGUAGE TupleSections #-}
17{-# LANGUAGE GADTs #-}
17module Network.BitTorrent.DHT.Query 18module Network.BitTorrent.DHT.Query
18 ( -- * Handler 19 ( -- * Handler
19 -- | To bind specific set of handlers you need to pass 20 -- | To bind specific set of handlers you need to pass
@@ -71,6 +72,7 @@ import Data.Either
71import Data.List as L 72import Data.List as L
72import Data.Monoid 73import Data.Monoid
73import Data.Text as T 74import Data.Text as T
75import Data.BEncode (BValue)
74import qualified Data.Set as Set 76import qualified Data.Set as Set
75 ;import Data.Set (Set) 77 ;import Data.Set (Set)
76import Network 78import Network
@@ -89,14 +91,17 @@ import Network.BitTorrent.DHT.Routing as R
89import Network.BitTorrent.DHT.Session 91import Network.BitTorrent.DHT.Session
90import Control.Concurrent.STM 92import Control.Concurrent.STM
91import qualified Network.BitTorrent.DHT.Search as Search 93import qualified Network.BitTorrent.DHT.Search as Search
94import Network.DHT.Mainline
92 95
93{----------------------------------------------------------------------- 96{-----------------------------------------------------------------------
94-- Handlers 97-- Handlers
95-----------------------------------------------------------------------} 98-----------------------------------------------------------------------}
96 99
97nodeHandler :: Address ip => KRPC (Query a) (Response b) 100nodeHandler :: ( Address ip
101 , KRPC (Query a) (Response b)
102 , Envelope (Query a) (Response b) ~ BValue )
98 => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip 103 => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip
99nodeHandler action = handler $ \ sockAddr qry -> do 104nodeHandler action = handler mainline $ \ sockAddr qry -> do
100 let remoteId = queringNodeId qry 105 let remoteId = queringNodeId qry
101 read_only = queryIsReadOnly qry 106 read_only = queryIsReadOnly qry
102 q = queryParams qry 107 q = queryParams qry
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 82926b28..db8e7cff 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -106,6 +106,8 @@ import Data.Serialize as S
106import Data.Torrent as Torrent 106import Data.Torrent as Torrent
107import Network.KRPC as KRPC hiding (Options, def) 107import Network.KRPC as KRPC hiding (Options, def)
108import qualified Network.KRPC as KRPC (def) 108import qualified Network.KRPC as KRPC (def)
109import Network.KRPC.Message (KMessageOf)
110import Data.BEncode (BValue)
109import Network.BitTorrent.Address 111import Network.BitTorrent.Address
110import Network.BitTorrent.DHT.ContactInfo (PeerStore) 112import Network.BitTorrent.DHT.ContactInfo (PeerStore)
111import qualified Network.BitTorrent.DHT.ContactInfo as P 113import qualified Network.BitTorrent.DHT.ContactInfo as P
@@ -312,7 +314,7 @@ instance MonadLogger (DHT ip) where
312 logger <- asks loggerFun 314 logger <- asks loggerFun
313 liftIO $ logger loc src lvl (toLogStr msg) 315 liftIO $ logger loc src lvl (toLogStr msg)
314 316
315type NodeHandler ip = Handler (DHT ip) 317type NodeHandler ip = Handler (DHT ip) KMessageOf BValue
316 318
317-- | Run DHT session. You /must/ properly close session using 319-- | Run DHT session. You /must/ properly close session using
318-- 'closeNode' function, otherwise socket or other scarce resources may 320-- 'closeNode' function, otherwise socket or other scarce resources may