diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Query.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Query.hs | 6 |
1 files changed, 5 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index 9c52220e..4ba88b46 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs | |||
@@ -72,21 +72,25 @@ nodeHandler action = handler $ \ sockAddr (Query remoteId q) -> do | |||
72 | case fromSockAddr sockAddr of | 72 | case fromSockAddr sockAddr of |
73 | Nothing -> throwIO BadAddress | 73 | Nothing -> throwIO BadAddress |
74 | Just naddr -> do | 74 | Just naddr -> do |
75 | insertNode (NodeInfo remoteId naddr) | 75 | insertNode (NodeInfo remoteId naddr) -- TODO need to block. why? |
76 | Response <$> asks thisNodeId <*> action naddr q | 76 | Response <$> asks thisNodeId <*> action naddr q |
77 | 77 | ||
78 | -- | Default 'Ping' handler. | ||
78 | pingH :: Address ip => NodeHandler ip | 79 | pingH :: Address ip => NodeHandler ip |
79 | pingH = nodeHandler $ \ _ Ping -> do | 80 | pingH = nodeHandler $ \ _ Ping -> do |
80 | return Ping | 81 | return Ping |
81 | 82 | ||
83 | -- | Default 'FindNode' handler. | ||
82 | findNodeH :: Address ip => NodeHandler ip | 84 | findNodeH :: Address ip => NodeHandler ip |
83 | findNodeH = nodeHandler $ \ _ (FindNode nid) -> do | 85 | findNodeH = nodeHandler $ \ _ (FindNode nid) -> do |
84 | NodeFound <$> getClosest nid | 86 | NodeFound <$> getClosest nid |
85 | 87 | ||
88 | -- | Default 'GetPeers' handler. | ||
86 | getPeersH :: Address ip => NodeHandler ip | 89 | getPeersH :: Address ip => NodeHandler ip |
87 | getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do | 90 | getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do |
88 | GotPeers <$> getPeerList ih <*> grantToken naddr | 91 | GotPeers <$> getPeerList ih <*> grantToken naddr |
89 | 92 | ||
93 | -- | Default 'Announce' handler. | ||
90 | announceH :: Address ip => NodeHandler ip | 94 | announceH :: Address ip => NodeHandler ip |
91 | announceH = nodeHandler $ \ naddr @ NodeAddr {..} (Announce {..}) -> do | 95 | announceH = nodeHandler $ \ naddr @ NodeAddr {..} (Announce {..}) -> do |
92 | valid <- checkToken naddr sessionToken | 96 | valid <- checkToken naddr sessionToken |