diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Query.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Query.hs | 13 |
1 files changed, 12 insertions, 1 deletions
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 |