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
2020-04-15 00:02:10 +02:00 · 2020-04-15 00:02:10 +02:00 · 18bdcce266
parent 3db7fcfba5
commit 18bdcce266
3 changed files with 141 additions and 37 deletions
--- 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' 
--- 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,12 +80,14 @@ 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
+    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
@ -87,6 +95,7 @@ instance Ord NodeID where
    wayForwards = getNodeID (b - a)
    wayBackwards = getNodeID (a - b)

+
 -- | represents a node and all its important state
 data NodeState = NodeState {
    nid :: NodeID
@ -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
--- 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