From 18bdcce26629c7d6182f76db2ebe4c3bb40c81bd Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Wed, 15 Apr 2020 00:02:10 +0200 Subject: [PATCH] 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 --- Hash2Pub/src/Hash2Pub/DHTProtocol.hs | 18 +++-- Hash2Pub/src/Hash2Pub/FediChord.hs | 116 ++++++++++++++++++++++----- Hash2Pub/test/FediChordSpec.hs | 44 +++++++--- 3 files changed, 141 insertions(+), 37 deletions(-) diff --git a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs index 1098d85..90e6daa 100644 --- a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs +++ b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs @@ -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' diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index 8bb60f6..677fab4 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/Hash2Pub/src/Hash2Pub/FediChord.hs @@ -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 diff --git a/Hash2Pub/test/FediChordSpec.hs b/Hash2Pub/test/FediChordSpec.hs index a566a55..b54e095 100644 --- a/Hash2Pub/test/FediChordSpec.hs +++ b/Hash2Pub/test/FediChordSpec.hs @@ -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