summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/BitTorrent/DHT.hs55
1 files changed, 44 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index 5c5d017b..3be7cfa0 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -1,7 +1,15 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-} 2{-# LANGUAGE RecordWildCards #-}
3module Network.BitTorrent.DHT 3module Network.BitTorrent.DHT
4 ( dhtServer 4 (
5 -- * Tracker
6 ping
7 , findNode
8 , getPeers
9 , announcePeer
10
11 -- * Server
12 , dhtServer
5 ) where 13 ) where
6 14
7import Control.Applicative 15import Control.Applicative
@@ -136,6 +144,7 @@ data NodeSession = NodeSession {
136 , routingTable :: !(TVar RoutingTable) 144 , routingTable :: !(TVar RoutingTable)
137 , contactInfo :: !(TVar ContactInfo) 145 , contactInfo :: !(TVar ContactInfo)
138 , alpha :: !Alpha 146 , alpha :: !Alpha
147 , listenerPort :: !PortNumber
139 } 148 }
140 149
141instance Eq NodeSession where 150instance Eq NodeSession where
@@ -152,7 +161,7 @@ checkToken :: NodeId -> Token -> NodeSession -> IO Bool
152checkToken nid token _ = return True 161checkToken nid token _ = return True
153 162
154{----------------------------------------------------------------------- 163{-----------------------------------------------------------------------
155 Queries 164 DHT Queries
156-----------------------------------------------------------------------} 165-----------------------------------------------------------------------}
157 166
158pingM :: Method NodeId NodeId 167pingM :: Method NodeId NodeId
@@ -195,22 +204,46 @@ announcePeerM :: Method (NodeId, InfoHash, PortNumber, Token) NodeId
195announcePeerM = method "announce_peer" ["id", "info_hash", "port", "token"] ["id"] 204announcePeerM = method "announce_peer" ["id", "info_hash", "port", "token"] ["id"]
196 205
197{----------------------------------------------------------------------- 206{-----------------------------------------------------------------------
198 Tracker 207 DHT Tracker
199-----------------------------------------------------------------------} 208-----------------------------------------------------------------------}
209-- TODO: update node timestamp on each successful call
200 210
201pingC :: NodeSession -> NodeAddr -> IO () 211type DHT a b = NodeSession -> NodeAddr -> a -> IO b
202pingC NodeSession {..} addr @ NodeAddr {..} = do 212
213ping :: DHT () ()
214ping NodeSession {..} addr @ NodeAddr {..} () = do
203 nid <- call (nodeIP, nodePort) pingM nodeId 215 nid <- call (nodeIP, nodePort) pingM nodeId
204 atomically $ modifyTVar' routingTable $ HM.insert nid addr 216 atomically $ modifyTVar' routingTable $ HM.insert nid addr
205 217
206getPeerC :: NodeSession -> NodeAddr -> InfoHash -> IO () 218findNode :: DHT NodeId [NodeInfo]
207getPeerC NodeSession {..} addr @ NodeAddr {..} ih = do 219findNode NodeSession {..} NodeAddr {..} qnid = do
208 call (nodeIP, nodePort) getPeersM undefined 220 (_, info) <- call (nodeIP, nodePort) findNodeM (nodeId, qnid)
209 return () 221 return (decodeCompact info)
222
223getPeers :: DHT InfoHash (Either [NodeInfo] [PeerAddr])
224getPeers NodeSession {..} NodeAddr {..} ih = do
225 extrResp <$> call (nodeIP, nodePort) getPeersM (nodeId, ih)
226 where
227 extrResp (BDict d)
228 | Just (BList values) <- M.lookup "values" d
229 = Right $ decodePeerList values
230 | Just (BString nodes) <- M.lookup "nodes" d
231 = Left $ decodeCompact nodes
232 extrResp _ = return undefined
233
234-- remove token from signature, handle the all token stuff by NodeSession
235
236-- | Note that before ever calling this method you should call the
237-- getPeerList.
238announcePeer :: DHT (InfoHash, Token) NodeId
239announcePeer NodeSession {..} NodeAddr {..} (ih, tok) = do
240 call (nodeIP, nodePort) announcePeerM (nodeId, ih, listenerPort, tok)
210 241
211{----------------------------------------------------------------------- 242{-----------------------------------------------------------------------
212 Server 243 DHT Server
213-----------------------------------------------------------------------} 244-----------------------------------------------------------------------}
245-- TODO: update node timestamp on each successful call
246-- NOTE: ensure all server operations should run in O(1)
214 247
215type ServerHandler a b = NodeSession -> NodeAddr -> a -> IO b 248type ServerHandler a b = NodeSession -> NodeAddr -> a -> IO b
216 249
@@ -220,7 +253,7 @@ pingS NodeSession {..} addr nid = do
220 return nodeId 253 return nodeId
221 254
222findNodeS :: ServerHandler (NodeId, NodeId) (NodeId, CompactInfo) 255findNodeS :: ServerHandler (NodeId, NodeId) (NodeId, CompactInfo)
223findNodeS NodeSession {..} addr (nid, qnid) = do 256findNodeS NodeSession {..} _ (_, qnid) = do
224 rt <- atomically $ readTVar routingTable 257 rt <- atomically $ readTVar routingTable
225 return (nodeId, encodeCompact $ kclosest alpha qnid rt) 258 return (nodeId, encodeCompact $ kclosest alpha qnid rt)
226 259