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
import Data.Maybe (catMaybes)
import qualified Data.Map.Strict as M
import Hash2Pub.FediChord
( NodeID
, NodeState (..)
, cacheGetNodeStateUnvalidated
, NodeCache
, CacheEntry
, addCacheEntry
, deleteCacheEntry
, cacheLookup
, cacheLookupSucc
, cacheLookupPred
, localCompare
)
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 ownState nCache lBestNodes targetID
-- 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
-- the closest succeeding node (like with the p initiated parallel queries
| otherwise = FORWARD . catMaybes $ closestSuccessor : closestPredecessors
where
ownID = nid ownState
closestSuccessor :: Maybe CacheEntry
closestSuccessor = snd <$> M.lookupGT targetID nCache
closestSuccessor = cacheLookupSucc targetID nCache
closestPredecessors :: [Maybe CacheEntry]
closestPredecessors = closestPredecessor (lBestNodes-1) $ nid ownState
closestPredecessor :: (Integral n) => n -> NodeID -> [Maybe CacheEntry]
closestPredecessor 0 _ = []
closestPredecessor remainingLookups lastID =
let result = predecessorLookup nCache lastID
let result = cacheLookupPred lastID nCache
in
case result of
Nothing -> []
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
, NodeState (..)
, NodeCache
, CacheEntry
, CacheEntry(..)
, cacheGetNodeStateUnvalidated
, initCache
, addCacheEntry
, deleteCacheEntry
, cacheLookup
, cacheLookupSucc
, cacheLookupPred
, localCompare
, genNodeID
, genNodeIDBS
, genKeyID
@ -74,18 +80,21 @@ instance Num NodeID where
signum = NodeID . signum . getNodeID
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.
-- main idea: a node is preceding (LT) if the way forwards to the other node is smaller than the way backwards
-- 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 <=.
-- | use normal strict monotonic ordering of integers, realising the ring structure
-- is done in the @NodeCache@ implementation
instance Ord NodeID where
a `compare` b
| getNodeID a == getNodeID b = EQ
| wayForwards > wayBackwards = GT
| otherwise = LT
where
wayForwards = getNodeID (b - a)
wayBackwards = getNodeID (a - b)
a `compare` b = getNodeID a `compare` getNodeID b
-- | local comparison of 2 node IDs, only relevant for determining a successor or predecessor on caches with just 2 nodes
localCompare :: NodeID -> NodeID -> Ordering
a `localCompare` b
| getNodeID a == getNodeID b = EQ
| wayForwards > wayBackwards = GT
| otherwise = LT
where
wayForwards = getNodeID (b - a)
wayBackwards = getNodeID (a - b)
-- | represents a node and all its important state
data NodeState = NodeState {
@ -124,28 +133,93 @@ data NodeState = NodeState {
type NodeCache = Map.Map NodeID CacheEntry
-- |an entry of the 'nodeCache'
type CacheEntry = (
Bool
, NodeState
, UTCTime
) -- ^ ( a node's validation status, data, timestamp for cache entry expiration )
-- |an entry of the 'nodeCache' can hold 2 different kinds of data
data CacheEntry =
-- | an entry representing its validation status, the node state and its timestamp
NodeEntry Bool NodeState UTCTime
-- | a proxy field for closing the ring structure, indicating the lookup shall be
-- 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
now <- getCurrentTime
let
-- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity
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
-- | 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
-- transfer difference now - entry to other node
-- | return the @NodeState@ data from a cache entry without checking its validation status
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
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 Hash2Pub.FediChord
import Hash2Pub.DHTProtocol
spec :: Spec
spec = do
@ -17,16 +18,16 @@ spec = do
it "computes ID values within the modular bounds" $ do
getNodeID ((maxBound :: NodeID) + toNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True
3 * (maxBound :: NodeID) `shouldBe` fromInteger (-3)
it "uses comparison in the context of preceding/ succeding nodes on a ring" $ do
toNodeID 12 `compare` toNodeID 12 `shouldBe` EQ
it "local comparison works in the context of preceding/ succeding nodes on a ring" $ do
toNodeID 12 `localCompare` toNodeID 12 `shouldBe` EQ
let
a = toNodeID 3
b = toNodeID 3 - toNodeID 10
a > b `shouldBe` True
b < a `shouldBe` True
a `localCompare` b `shouldBe` GT
b `localCompare` a `shouldBe` LT
-- edge cases
(toNodeID 5001 - toNodeID 2^(255::Integer) < 5001) `shouldBe` True
(toNodeID 5001 - toNodeID 2^(255::Integer) - 1) < 5001 `shouldBe` False
((toNodeID 5001 - toNodeID 2^(255::Integer)) `localCompare` 5001) `shouldBe` LT
(toNodeID 5001 - toNodeID 2^(255::Integer) - 1) `localCompare` 5001 `shouldBe` GT
it "throws an exception when @toNodeID@ on out-of-bound values"
pending
it "can be generated" $ do
@ -54,7 +55,7 @@ spec = do
, ipAddr = exampleIp
, dhtPort = 2342
, apPort = Nothing
, nodeCache = Map.empty
, nodeCache = initCache
, successors = []
, predecessors = []
, kNeighbours = 3
@ -70,9 +71,32 @@ spec = do
it "entries can be added to a node cache" $ do
let
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
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
@ -83,7 +107,7 @@ exampleNodeState = NodeState {
, ipAddr = exampleIp
, dhtPort = 2342
, apPort = Nothing
, nodeCache = Map.empty
, nodeCache = initCache
, successors = []
, predecessors = []
, kNeighbours = 3