diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT.hs | 65 |
1 files changed, 60 insertions, 5 deletions
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index 8bc423a3..6d31eab2 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs | |||
@@ -76,8 +76,13 @@ import Data.Typeable | |||
76 | import Data.Monoid | 76 | import Data.Monoid |
77 | import Network.DatagramServer.Mainline (KMessageOf) | 77 | import Network.DatagramServer.Mainline (KMessageOf) |
78 | import qualified Network.DatagramServer as KRPC (listen, Protocol(..)) | 78 | import qualified Network.DatagramServer as KRPC (listen, Protocol(..)) |
79 | 79 | import Network.DatagramServer.Types | |
80 | 80 | import Network.DHT.Types | |
81 | import Data.Bits | ||
82 | import Data.Default | ||
83 | import Text.PrettyPrint.HughesPJClass hiding (($$), (<>)) | ||
84 | import Network.KRPC.Method | ||
85 | import Network.BitTorrent.DHT.Query (DataHandlers) | ||
81 | 86 | ||
82 | {----------------------------------------------------------------------- | 87 | {----------------------------------------------------------------------- |
83 | -- DHT types | 88 | -- DHT types |
@@ -96,7 +101,31 @@ fullLogging :: LogSource -> LogLevel -> Bool | |||
96 | fullLogging _ _ = True | 101 | fullLogging _ _ = True |
97 | 102 | ||
98 | -- | Run DHT on specified port. <add note about resources> | 103 | -- | Run DHT on specified port. <add note about resources> |
99 | dht :: (Ord ip, Address ip) | 104 | dht :: |
105 | ( Ord ip | ||
106 | , Address ip | ||
107 | , Functor dht | ||
108 | , Ord (NodeId dht) | ||
109 | , FiniteBits (NodeId dht) | ||
110 | , Serialize (NodeId dht) | ||
111 | , Show (NodeId dht) | ||
112 | , SerializableTo raw (Response dht (Ping dht)) | ||
113 | , SerializableTo raw (Query dht (Ping dht)) | ||
114 | , SerializableTo raw (Response dht (NodeFound dht ip)) | ||
115 | , SerializableTo raw (Query dht (FindNode dht ip)) | ||
116 | , Ord (TransactionID dht) | ||
117 | , Serialize (TransactionID dht) | ||
118 | , Eq (QueryMethod dht) | ||
119 | , Show (QueryMethod dht) | ||
120 | , Pretty (NodeInfo dht ip u) | ||
121 | , Kademlia dht | ||
122 | , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) | ||
123 | , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) | ||
124 | , DataHandlers raw dht | ||
125 | , WireFormat raw dht | ||
126 | , Show u | ||
127 | , Default u | ||
128 | ) | ||
100 | => Options -- ^ normally you need to use 'Data.Default.def'; | 129 | => Options -- ^ normally you need to use 'Data.Default.def'; |
101 | -> NodeAddr ip -- ^ address to bind this node; | 130 | -> NodeAddr ip -- ^ address to bind this node; |
102 | -> (LogSource -> LogLevel -> Bool) -- ^ use 'fullLogging' as a noisy default | 131 | -> (LogSource -> LogLevel -> Bool) -- ^ use 'fullLogging' as a noisy default |
@@ -179,7 +208,33 @@ resolveHostName NodeAddr {..} = do | |||
179 | -- | 208 | -- |
180 | -- This operation do block, use | 209 | -- This operation do block, use |
181 | -- 'Control.Concurrent.Async.Lifted.async' if needed. | 210 | -- 'Control.Concurrent.Async.Lifted.async' if needed. |
182 | bootstrap :: forall raw dht u ip. Address ip => Maybe BS.ByteString -> [NodeAddr ip] -> DHT raw dht u ip () | 211 | bootstrap :: forall raw dht u ip. |
212 | ( Ord ip | ||
213 | , Address ip | ||
214 | , Functor dht | ||
215 | , Ord (NodeId dht) | ||
216 | , FiniteBits (NodeId dht) | ||
217 | , Serialize (NodeId dht) | ||
218 | , Show (NodeId dht) | ||
219 | , Pretty (NodeId dht) | ||
220 | , SerializableTo raw (Response dht (Ping dht)) | ||
221 | , SerializableTo raw (Query dht (Ping dht)) | ||
222 | , SerializableTo raw (Response dht (NodeFound dht ip)) | ||
223 | , SerializableTo raw (Query dht (FindNode dht ip)) | ||
224 | , Ord (TransactionID dht) | ||
225 | , Serialize (TransactionID dht) | ||
226 | , Eq (QueryMethod dht) | ||
227 | , Show (QueryMethod dht) | ||
228 | , Pretty (NodeInfo dht ip u) | ||
229 | , Kademlia dht | ||
230 | , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) | ||
231 | , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) | ||
232 | , DataHandlers raw dht | ||
233 | , WireFormat raw dht | ||
234 | , Show u | ||
235 | , Default u | ||
236 | , Serialize u | ||
237 | ) => Maybe BS.ByteString -> [NodeAddr ip] -> DHT raw dht u ip () | ||
183 | bootstrap mbs startNodes = do | 238 | bootstrap mbs startNodes = do |
184 | restored <- | 239 | restored <- |
185 | case decode <$> mbs of | 240 | case decode <$> mbs of |
@@ -192,7 +247,7 @@ bootstrap mbs startNodes = do | |||
192 | let searchAll aliveNodes = do | 247 | let searchAll aliveNodes = do |
193 | nid <- myNodeIdAccordingTo (error "FIXME") | 248 | nid <- myNodeIdAccordingTo (error "FIXME") |
194 | ns <- bgsearch ioFindNodes nid | 249 | ns <- bgsearch ioFindNodes nid |
195 | return ( ns :: [NodeInfo KMessageOf ip ()] ) | 250 | return ( ns :: [NodeInfo dht ip u] ) |
196 | input_nodes <- (restored ++) . T.toList <$> getTable | 251 | input_nodes <- (restored ++) . T.toList <$> getTable |
197 | -- Step 1: Use iterative searches to flesh out the table.. | 252 | -- Step 1: Use iterative searches to flesh out the table.. |
198 | do let knowns = map (map $ nodeAddr . fst) input_nodes | 253 | do let knowns = map (map $ nodeAddr . fst) input_nodes |