re-implement NodeCache data structure to emulate ring properly

- previously, there was at least 1 gap in the identifier ring
- now use normal integer comparison again, but forward lookups using
  proxy entries at the ID space boundaries
- wrap cache operations to properly handle proxy elements
- fix all previously working tests
- document choice of cache data structure
This commit is contained in:
Trolli Schmittlauch 2020-04-15 00:02:10 +02:00
parent 3db7fcfba5
commit 18bdcce266
3 changed files with 141 additions and 37 deletions

View file

@ -7,13 +7,18 @@ module Hash2Pub.DHTProtocol
where where
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import qualified Data.Map.Strict as M
import Hash2Pub.FediChord import Hash2Pub.FediChord
( NodeID ( NodeID
, NodeState (..) , NodeState (..)
, cacheGetNodeStateUnvalidated , cacheGetNodeStateUnvalidated
, NodeCache , NodeCache
, CacheEntry , CacheEntry
, addCacheEntry
, deleteCacheEntry
, cacheLookup
, cacheLookupSucc
, cacheLookupPred
, localCompare
) )
data QueryResponse = FORWARD [CacheEntry] -- ^return closest nodes from local cache. data QueryResponse = FORWARD [CacheEntry] -- ^return closest nodes from local cache.
@ -28,23 +33,24 @@ data QueryResponse = FORWARD [CacheEntry] -- ^return closest nodes from local ca
incomingQuery :: NodeState -> NodeCache -> Int -> NodeID -> QueryResponse incomingQuery :: NodeState -> NodeCache -> Int -> NodeID -> QueryResponse
incomingQuery ownState nCache lBestNodes targetID incomingQuery ownState nCache lBestNodes targetID
-- as target ID falls between own ID and first predecessor, it is handled by this node -- as target ID falls between own ID and first predecessor, it is handled by this node
| targetID <= nid ownState && targetID > (head . predecessors) ownState = FOUND ownState -- TODO: this fails with an empty predecessor list
| (targetID `localCompare` ownID) `elem` [LT, EQ] && (targetID `localCompare` (head . predecessors) ownState) == GT = FOUND ownState
-- my interpretation: the "l best next hops" are the l-1 closest preceding nodes and -- my interpretation: the "l best next hops" are the l-1 closest preceding nodes and
-- the closest succeeding node (like with the p initiated parallel queries -- the closest succeeding node (like with the p initiated parallel queries
| otherwise = FORWARD . catMaybes $ closestSuccessor : closestPredecessors | otherwise = FORWARD . catMaybes $ closestSuccessor : closestPredecessors
where where
ownID = nid ownState
closestSuccessor :: Maybe CacheEntry closestSuccessor :: Maybe CacheEntry
closestSuccessor = snd <$> M.lookupGT targetID nCache closestSuccessor = cacheLookupSucc targetID nCache
closestPredecessors :: [Maybe CacheEntry] closestPredecessors :: [Maybe CacheEntry]
closestPredecessors = closestPredecessor (lBestNodes-1) $ nid ownState closestPredecessors = closestPredecessor (lBestNodes-1) $ nid ownState
closestPredecessor :: (Integral n) => n -> NodeID -> [Maybe CacheEntry] closestPredecessor :: (Integral n) => n -> NodeID -> [Maybe CacheEntry]
closestPredecessor 0 _ = [] closestPredecessor 0 _ = []
closestPredecessor remainingLookups lastID = closestPredecessor remainingLookups lastID =
let result = predecessorLookup nCache lastID let result = cacheLookupPred lastID nCache
in in
case result of case result of
Nothing -> [] Nothing -> []
Just nPred -> result:closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred) Just nPred -> result:closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred)
predecessorLookup :: NodeCache -> NodeID -> Maybe CacheEntry
predecessorLookup nCache' lastID = snd <$> M.lookupLT lastID nCache'

View file

@ -15,9 +15,15 @@ module Hash2Pub.FediChord (
, toNodeID , toNodeID
, NodeState (..) , NodeState (..)
, NodeCache , NodeCache
, CacheEntry , CacheEntry(..)
, cacheGetNodeStateUnvalidated , cacheGetNodeStateUnvalidated
, initCache
, addCacheEntry , addCacheEntry
, deleteCacheEntry
, cacheLookup
, cacheLookupSucc
, cacheLookupPred
, localCompare
, genNodeID , genNodeID
, genNodeIDBS , genNodeIDBS
, genKeyID , genKeyID
@ -74,18 +80,21 @@ instance Num NodeID where
signum = NodeID . signum . getNodeID signum = NodeID . signum . getNodeID
abs = NodeID . abs . getNodeID -- ToDo: make sure that at creation time only IDs within the range are used abs = NodeID . abs . getNodeID -- ToDo: make sure that at creation time only IDs within the range are used
-- |NodeIDs on a ring are assigned an Ordering for finding a preceding node. -- | use normal strict monotonic ordering of integers, realising the ring structure
-- main idea: a node is preceding (LT) if the way forwards to the other node is smaller than the way backwards -- is done in the @NodeCache@ implementation
-- problem: equality of ways /= (a == b), so even equal-way paths don't return EQ. The equality-of-ways case is assigned to LT,
-- as preceding EpiChord nodes are nodes <=.
instance Ord NodeID where instance Ord NodeID where
a `compare` b a `compare` b = getNodeID a `compare` getNodeID b
| getNodeID a == getNodeID b = EQ
| wayForwards > wayBackwards = GT -- | local comparison of 2 node IDs, only relevant for determining a successor or predecessor on caches with just 2 nodes
| otherwise = LT localCompare :: NodeID -> NodeID -> Ordering
where a `localCompare` b
wayForwards = getNodeID (b - a) | getNodeID a == getNodeID b = EQ
wayBackwards = getNodeID (a - b) | wayForwards > wayBackwards = GT
| otherwise = LT
where
wayForwards = getNodeID (b - a)
wayBackwards = getNodeID (a - b)
-- | represents a node and all its important state -- | represents a node and all its important state
data NodeState = NodeState { data NodeState = NodeState {
@ -124,28 +133,93 @@ data NodeState = NodeState {
type NodeCache = Map.Map NodeID CacheEntry type NodeCache = Map.Map NodeID CacheEntry
-- |an entry of the 'nodeCache' -- |an entry of the 'nodeCache' can hold 2 different kinds of data
type CacheEntry = ( data CacheEntry =
Bool -- | an entry representing its validation status, the node state and its timestamp
, NodeState NodeEntry Bool NodeState UTCTime
, UTCTime -- | a proxy field for closing the ring structure, indicating the lookup shall be
) -- ^ ( a node's validation status, data, timestamp for cache entry expiration ) -- resumed at the given @NodeID@ unless the @ProxyEntry@ itself holds a @NodeEntry@
| ProxyEntry NodeID (Maybe CacheEntry)
deriving (Show, Eq)
addCacheEntry :: NodeState -> Integer -> NodeCache -> IO NodeCache -- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
-- linking the modular name space together by connecting @minBound@ and @maxBound@
initCache :: NodeCache
initCache = Map.fromList $ proxyEntry <$> [(maxBound, minBound), (minBound, maxBound)]
where
proxyEntry (from,to) = (from, ProxyEntry to Nothing)
-- | insert a new @NodeState@ node into the cache
addCacheEntry :: NodeState -- ^ the node to insert
-> Integer -- ^ initial age penalty in seconds
-> NodeCache -- ^ node cache to insert to
-> IO NodeCache -- ^ new node cache with the element inserted
addCacheEntry node diffSeconds cache = do addCacheEntry node diffSeconds cache = do
now <- getCurrentTime now <- getCurrentTime
let let
-- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity
timestamp = fromInteger (negate diffSeconds) `addUTCTime` now timestamp = fromInteger (negate diffSeconds) `addUTCTime` now
newCache = Map.insert (nid node) (False, node, timestamp) cache newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp) cache
insertCombineFunction newVal oldVal =
case oldVal of
ProxyEntry n _ -> ProxyEntry n (Just newVal)
_ -> newVal
return newCache return newCache
-- | delete the node with given ID from cache
deleteCacheEntry :: NodeID -- ^ID of the node to be deleted
-> NodeCache -- ^cache to delete from
-> NodeCache -- ^cache without the specified element
deleteCacheEntry = Map.update modifier
where
modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
modifier NodeEntry {} = Nothing
-- | Maybe returns the cache entry stored at given key
cacheLookup :: NodeID -- ^lookup key
-> NodeCache -- ^lookup cache
-> Maybe CacheEntry
cacheLookup key cache = case Map.lookup key cache of
Just (ProxyEntry _ result) -> result
res -> res
-- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
-- to simulate a modular ring
lookupWrapper :: (NodeID -> NodeCache -> Maybe (a, CacheEntry)) -> NodeID -> NodeCache -> Maybe CacheEntry
lookupWrapper f key cache =
case snd <$> f key cache of
-- the proxy entry found holds a
Just (ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry
-- proxy entry holds another proxy entry, this should not happen
Just (ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing
-- proxy entry without own entry is a pointer on where to continue
Just (ProxyEntry pointer Nothing) -> lookupWrapper f pointer cache
-- normal entries are returned
Just entry@NodeEntry{} -> Just entry
Nothing -> Nothing
-- | find the successor node to a given key on a modular EpiChord ring cache.
-- Note: The EpiChord definition of "successor" includes the node at the key itself,
-- if existing.
cacheLookupSucc :: NodeID -- ^lookup key
-> NodeCache -- ^ring cache
-> Maybe CacheEntry
cacheLookupSucc = lookupWrapper Map.lookupGE
-- | find the predecessor node to a given key on a modular EpiChord ring cache.
cacheLookupPred :: NodeID -- ^lookup key
-> NodeCache -- ^ring cache
-> Maybe CacheEntry
cacheLookupPred = lookupWrapper Map.lookupLT
-- clean up cache entries: once now - entry > maxAge -- clean up cache entries: once now - entry > maxAge
-- transfer difference now - entry to other node -- transfer difference now - entry to other node
-- | return the @NodeState@ data from a cache entry without checking its validation status -- | return the @NodeState@ data from a cache entry without checking its validation status
cacheGetNodeStateUnvalidated :: CacheEntry -> NodeState cacheGetNodeStateUnvalidated :: CacheEntry -> NodeState
cacheGetNodeStateUnvalidated (_, nState, _) = nState cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
cacheGetNodeStateUnvalidated _ = error "trying to return empty node state, please report a bug"
-- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString -- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString
genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address

View file

@ -8,6 +8,7 @@ import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Hash2Pub.FediChord import Hash2Pub.FediChord
import Hash2Pub.DHTProtocol
spec :: Spec spec :: Spec
spec = do spec = do
@ -17,16 +18,16 @@ spec = do
it "computes ID values within the modular bounds" $ do it "computes ID values within the modular bounds" $ do
getNodeID ((maxBound :: NodeID) + toNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True getNodeID ((maxBound :: NodeID) + toNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True
3 * (maxBound :: NodeID) `shouldBe` fromInteger (-3) 3 * (maxBound :: NodeID) `shouldBe` fromInteger (-3)
it "uses comparison in the context of preceding/ succeding nodes on a ring" $ do it "local comparison works in the context of preceding/ succeding nodes on a ring" $ do
toNodeID 12 `compare` toNodeID 12 `shouldBe` EQ toNodeID 12 `localCompare` toNodeID 12 `shouldBe` EQ
let let
a = toNodeID 3 a = toNodeID 3
b = toNodeID 3 - toNodeID 10 b = toNodeID 3 - toNodeID 10
a > b `shouldBe` True a `localCompare` b `shouldBe` GT
b < a `shouldBe` True b `localCompare` a `shouldBe` LT
-- edge cases -- edge cases
(toNodeID 5001 - toNodeID 2^(255::Integer) < 5001) `shouldBe` True ((toNodeID 5001 - toNodeID 2^(255::Integer)) `localCompare` 5001) `shouldBe` LT
(toNodeID 5001 - toNodeID 2^(255::Integer) - 1) < 5001 `shouldBe` False (toNodeID 5001 - toNodeID 2^(255::Integer) - 1) `localCompare` 5001 `shouldBe` GT
it "throws an exception when @toNodeID@ on out-of-bound values" it "throws an exception when @toNodeID@ on out-of-bound values"
pending pending
it "can be generated" $ do it "can be generated" $ do
@ -54,7 +55,7 @@ spec = do
, ipAddr = exampleIp , ipAddr = exampleIp
, dhtPort = 2342 , dhtPort = 2342
, apPort = Nothing , apPort = Nothing
, nodeCache = Map.empty , nodeCache = initCache
, successors = [] , successors = []
, predecessors = [] , predecessors = []
, kNeighbours = 3 , kNeighbours = 3
@ -70,9 +71,32 @@ spec = do
it "entries can be added to a node cache" $ do it "entries can be added to a node cache" $ do
let let
emptyCache = nodeCache exampleNodeState emptyCache = nodeCache exampleNodeState
anotherNode = exampleNodeState { nid = (toNodeID 2^(23::Integer)+1)} anotherNode = exampleNodeState { nid = toNodeID 2^(23::Integer)+1}
newCache <- addCacheEntry exampleNodeState 0 =<< addCacheEntry anotherNode 10 emptyCache newCache <- addCacheEntry exampleNodeState 0 =<< addCacheEntry anotherNode 10 emptyCache
Map.size newCache `shouldBe` 2 Map.size newCache - Map.size emptyCache `shouldBe` 2
-- ToDo: query/ retrieve
describe "NodeCache query lookups" $ do
let
emptyCache = Map.empty :: NodeCache
node1 = exampleNodeState { nid = toNodeID 2^(23::Integer)+1}
node2 = exampleNodeState { nid = toNodeID 2^(230::Integer)+12}
node3 = exampleNodeState { nid = toNodeID 2^(25::Integer)+10}
node4 = exampleNodeState { nid = toNodeID 2^(9::Integer)+100}
--cacheWith2Entries <- mapM (\n -> addCacheEntry n 0) [node1, node2] $ emptyCache
cacheWith2Entries = addCacheEntry node1 120 =<< addCacheEntry node2 0 emptyCache
cacheWith4Entries = addCacheEntry node3 110 =<< addCacheEntry node4 0 =<< cacheWith2Entries
it "work on an empty cache" $ do
incomingQuery exampleNodeState emptyCache 3 (toNodeID 2^(25::Integer)) `shouldBe` FORWARD []
incomingQuery exampleNodeState emptyCache 1 (toNodeID 2342) `shouldBe` FORWARD []
it "work on a cache with less entries than needed" $ do
c2 <- cacheWith2Entries
print c2
let (FORWARD nodelist) = incomingQuery exampleNodeState emptyCache 3 (toNodeID 2^(25::Integer))
map (nid . cacheGetNodeStateUnvalidated) nodelist `shouldBe` []
it "work on a cache with sufficient entries" $ do
c4 <- cacheWith4Entries
incomingQuery exampleNodeState c4 3 (toNodeID 2342) `shouldBe` FORWARD []
incomingQuery exampleNodeState c4 1 (toNodeID 2342) `shouldBe` FORWARD []
-- some example data -- some example data
@ -83,7 +107,7 @@ exampleNodeState = NodeState {
, ipAddr = exampleIp , ipAddr = exampleIp
, dhtPort = 2342 , dhtPort = 2342
, apPort = Nothing , apPort = Nothing
, nodeCache = Map.empty , nodeCache = initCache
, successors = [] , successors = []
, predecessors = [] , predecessors = []
, kNeighbours = 3 , kNeighbours = 3