summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT/ContactInfo.hs
blob: d7c92e3562115e7daf91d4f8246a47b12d4d5182 (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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
module Network.BitTorrent.DHT.ContactInfo
       ( PeerStore
       , Network.BitTorrent.DHT.ContactInfo.lookup
       , Network.BitTorrent.DHT.ContactInfo.insert
       ) where

import Data.Default
import Data.List as L
import Data.Maybe
import Data.HashMap.Strict as HM
import Data.Serialize

import Data.Torrent
import Network.BitTorrent.Address

-- {-
-- import Data.HashMap.Strict as HM
--
-- import Data.Torrent.InfoHash
-- import Network.BitTorrent.Address
--
-- -- increase prefix when table is too large
-- -- decrease prefix when table is too small
-- -- filter outdated peers
--
-- {-----------------------------------------------------------------------
-- --  PeerSet
-- -----------------------------------------------------------------------}
--
-- type PeerSet a = [(PeerAddr a, NodeInfo a, Timestamp)]
--
-- -- compare PSQueue vs Ordered list
--
-- takeNewest :: PeerSet a -> [PeerAddr a]
-- takeNewest = undefined
--
-- dropOld :: Timestamp -> PeerSet a -> PeerSet a
-- dropOld = undefined
--
-- insert :: PeerAddr a -> Timestamp -> PeerSet a -> PeerSet a
-- insert = undefined
--
-- type Mask = Int
-- type Size = Int
-- type Timestamp = Int
--
-- {-----------------------------------------------------------------------
-- --  InfoHashMap
-- -----------------------------------------------------------------------}
--
-- -- compare handwritten prefix tree versus IntMap
--
-- data Tree a
--   = Nil
--   | Tip !InfoHash !(PeerSet a)
--   | Bin !InfoHash !Mask !Size !Timestamp (Tree a) (Tree a)
--
-- insertTree :: InfoHash -> a -> Tree a -> Tree a
-- insertTree = undefined
--
-- type Prio = Int
--
-- --shrink :: ContactInfo ip -> Int
-- shrink  Nil      = Nil
-- shrink (Tip _ _) = undefined
-- shrink (Bin _ _) = undefined
--
-- {-----------------------------------------------------------------------
-- -- InfoHashMap
-- -----------------------------------------------------------------------}
--
-- -- compare new design versus HashMap
--
-- data IntMap k p a
-- type ContactInfo = Map InfoHash Timestamp (Set (PeerAddr IP) Timestamp)
--
-- data ContactInfo ip = PeerStore
--   { maxSize    :: Int
--   , prefixSize :: Int
--   , thisNodeId :: NodeId
--
--   , count      :: Int  -- ^ Cached size of the 'peerSet'
--   , peerSet    :: HashMap InfoHash [PeerAddr ip]
--   }
--
-- size :: ContactInfo ip -> Int
-- size = undefined
--
-- prefixSize :: ContactInfo ip -> Int
-- prefixSize = undefined
--
-- lookup :: InfoHash -> ContactInfo ip -> [PeerAddr ip]
-- lookup = undefined
--
-- insert :: InfoHash -> PeerAddr ip -> ContactInfo ip -> ContactInfo ip
-- insert = undefined
--
-- -- | Limit in size.
-- prune :: NodeId -> Int -> ContactInfo ip -> ContactInfo ip
-- prune pref targetSize  Nil      = Nil
-- prune pref targetSize (Tip _ _) = undefined
--
-- -- | Remove expired entries.
-- splitGT :: Timestamp -> ContactInfo ip -> ContactInfo ip
-- splitGT = undefined
-- -}

-- | Storage used to keep track a set of known peers in client,
-- tracker or DHT sessions.
newtype PeerStore ip = PeerStore (HashMap InfoHash [PeerAddr ip])

-- | Empty store.
instance Default (PeerStore a) where
  def = PeerStore HM.empty
  {-# INLINE def #-}

-- | Monoid under union operation.
instance Eq a => Monoid (PeerStore a) where
  mempty  = def
  {-# INLINE mempty #-}

  mappend (PeerStore a) (PeerStore b) =
    PeerStore (HM.unionWith L.union a b)
  {-# INLINE mappend #-}

-- | Can be used to store peers between invocations of the client
-- software.
instance Serialize (PeerStore a) where
  get = undefined
  put = undefined

-- | Used in 'get_peers' DHT queries.
lookup :: InfoHash -> PeerStore a -> [PeerAddr a]
lookup ih (PeerStore m) = fromMaybe [] $ HM.lookup ih m

-- | Used in 'announce_peer' DHT queries.
insert :: Eq a => InfoHash -> PeerAddr a -> PeerStore a -> PeerStore a
insert ih a (PeerStore m) = PeerStore (HM.insertWith L.union ih [a] m)