summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT.hs
blob: bdb76c7648ba379caa598d132fb1057d7c3e9bbf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
module Network.BitTorrent.DHT
       ( dht
       , ping
       , Network.BitTorrent.DHT.bootstrap
       , Network.BitTorrent.DHT.lookup
       , Network.BitTorrent.DHT.insert
       ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Data.List as L
import Network.Socket (PortNumber)

import Data.Torrent.InfoHash
import Network.BitTorrent.Core
import Network.BitTorrent.DHT.Message
import Network.BitTorrent.DHT.Session


{-----------------------------------------------------------------------
--  Handlers
-----------------------------------------------------------------------}

pingH :: Address ip => NodeHandler ip
pingH = nodeHandler $ \ _ Ping -> return Ping

{-
findNodeH :: (Eq ip, Serialize ip, Typeable ip) => Handler (DHT ip)
findNodeH = dhtHandler $ \ _ (FindNode nid) ->
  NodeFound <$> getClosest nid

getPeersH :: (Eq ip, Serialize ip, Typeable ip) => Handler (DHT ip)
getPeersH = dhtHandler $ \ addr (GetPeers ih) ->
  GotPeers <$> getPeerList ih <*> grantToken addr

announceH :: Handler (DHT ip)
announceH = dhtHandler $ \ addr (Announce {..}) -> do
  checkToken addr sessionToken
  insertPeer topic undefined -- PeerAddr (add, port)
  return Announced
-}

handlers :: Address ip => [NodeHandler ip]
handlers = [pingH]

{-----------------------------------------------------------------------
--  Query
-----------------------------------------------------------------------}

-- | Run DHT on specified port. <add note about resources>
dht :: Address ip => NodeAddr ip -> DHT ip a -> IO a
dht addr = runDHT addr handlers

ping :: Address ip => NodeAddr ip -> DHT ip ()
ping addr = do
  Ping <- Ping <@> addr
  return ()

-- | One good node may be sufficient. <note about 'Data.Torrent.tNodes'>
bootstrap :: Address ip => [NodeAddr ip] -> DHT ip ()
bootstrap = mapM_ insertClosest
  where
    insertClosest addr = do
      nid <- getNodeId
      NodeFound closest <- FindNode nid <@> addr
      forM_ closest insertNode

-- | Get list of peers which downloading
lookup :: Address ip => InfoHash -> DHT ip [PeerAddr ip]
lookup ih = getClosestHash ih >>= collect
  where
    collect nodes = L.concat <$> forM (nodeAddr <$> nodes) retrieve
    retrieve addr = do
      GotPeers {..} <- GetPeers ih <@> addr
      either collect pure peers

-- | Announce that /this/ peer may have some pieces of the specified
-- torrent.
insert :: Address ip => InfoHash -> PortNumber -> DHT ip ()
insert ih port = do
  nodes <- getClosestHash ih
  forM_ (nodeAddr <$> nodes) $ \ addr -> do
--    GotPeers {..} <- GetPeers ih <@> addr
--    Announced     <- Announce False ih undefined grantedToken <@> addr
    return ()