check cache invariant for successors and lookup missing IDs

first half of #30

src/Hash2Pub/FediChord.hs

@@ -231,10 +231,55 @@ cacheVerifyThread nsSTM = forever $ do
                            ) pong
            else pure ()
                                )
-
+    
+    -- check the cache invariant per slice and, if necessary, do a single lookup to the
+    -- middle of each slice not verifying the invariant
+    latestNs <- readTVarIO nsSTM
+    latestCache <- readTVarIO $ nodeCacheSTM latestNs
+    let nodesToQuery targetID = case queryLocalCache latestNs latestCache (lNumBestNodes latestNs) targetID of
+                                  FOUND node -> [node]
+                                  FORWARD nodeSet -> remoteNode <$> Set.elems nodeSet
+    forM_ (checkCacheSliceInvariants latestNs latestCache) (\targetID ->
+        forkIO $ sendQueryIdMessages targetID latestNs (Just (1 + jEntriesPerSlice latestNs)) (nodesToQuery targetID) >> pure () -- ask for 1 entry more than j because of querying the middle
+                                                             )
+    
     threadDelay $ toEnum (fromEnum maxEntryAge `div` 20)
 
 
+-- | Checks the invariant of at least @jEntries@ per cache slice.
+-- If this invariant does not hold, the middle of the slice is returned for
+-- making lookups to that ID
+checkCacheSliceInvariants :: LocalNodeState
+                          -> NodeCache
+                          -> [NodeID]   -- ^ list of middle IDs of slices not
+                                        -- ^ fulfilling the invariant
+checkCacheSliceInvariants ns = checkSuccessorSlice jEntries (getNid ns) startBound lastSucc
+  where
+    jEntries = jEntriesPerSlice ns
+    lastSucc = getNid <$> lastMay (successors ns)
+    -- start slice boundary: 1/2 key space
+    startBound = getNid ns + 2^(idBits - 1)
+
+    checkSuccessorSlice :: Integral i => i -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [NodeID]
+    checkSuccessorSlice _ _ _ Nothing _ = []
+    checkSuccessorSlice j ownID upperBound (Just lastSuccID) cache
+      | (upperBound `localCompare` lastSuccID) == LT = []
+      | otherwise =
+          let
+            diff = getNodeID $ upperBound - ownID
+            lowerBound = ownID + fromInteger (diff `div` 2)
+            middleID = lowerBound + fromInteger (diff `div` 4)
+            lookupResult = Set.map (getNid . remoteNode) $ closestCachePredecessors jEntries upperBound cache
+           in
+           -- check whether j entries are in the slice
+           if length lookupResult == jEntries
+              && all (\r -> (r `localCompare` lowerBound) == GT) lookupResult
+              && all (\r -> (r `localCompare` upperBound) == LT) lookupResult
+              then checkSuccessorSlice j ownID (lowerBound - 1) (Just lastSuccID) cache
+              -- if not enough entries, add the middle of the slice to list
+              else middleID : checkSuccessorSlice j ownID (lowerBound - 1) (Just lastSuccID) cache
+
+
 
 -- | Periodically send @StabiliseRequest' s to the closest neighbour nodes, until
 -- one responds, and get their neighbours for maintaining the own neighbour lists.

src/Hash2Pub/FediChordTypes.hs

@@ -564,47 +564,6 @@ byteStringToUInteger bs = sum $ parsedBytes 0 bs
     parseWithOffset 0 word      = toInteger word  -- a shift of 0 is always 0
     parseWithOffset offset word =  toInteger word * 2^(8 * offset)
 
-
-
--- TODO: complete rewrite
--- |checks wether the cache entries fulfill the logarithmic EpiChord invariant
--- of having j entries per slice, and creates a list of necessary lookup actions.
--- Should be invoked periodically.
---checkCacheSlices :: NodeState -> IO [()]
---checkCacheSlices state = case getNodeCache state of
---    -- don't do anything on nodes without a cache
---    Nothing -> pure [()]
---    Just cache' -> checkSlice jEntries (nid state) startBound lastSucc =<< readIORef cache'
---    -- TODO: do the same for predecessors
---    where
---        jEntries = fromMaybe 0 $ getInternals_ jEntriesPerSlice state
---        lastSucc = last <$> maybeEmpty (fromMaybe [] $ getSuccessors state)
---        startBound = NodeID 2^(255::Integer) + nid state
---        checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()]
---        checkSlice _ _ _ Nothing _ = []
---        checkSlice j ownID upperBound (Just lastSuccNode) cache
---            | upperBound < lastSuccNode = []
---            | otherwise =
---                -- continuously half the DHT namespace, take the upper part as a slice,
---                -- check for existing entries in that slice and create a lookup action
---                -- and recursively do this on the lower half.
---                -- recursion edge case: all successors/ predecessors need to be in the
---                -- first slice.
---                let
---                  diff = getNodeID $ upperBound - ownID
---                  lowerBound = ownID + NodeID (diff `div` 2)
---                in
---                   -- TODO: replace empty IO actions with actual lookups to middle of slice
---                   -- TODO: validate ID before adding to cache
---                   case Map.lookupLT upperBound cache of
---                       Nothing -> pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
---                       Just (matchID, _) ->
---                           if
---                               matchID <= lowerBound then pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
---                           else
---                               checkSlice j ownID lowerBound (Just lastSuccNode) cache
-
-
 -- Todo: DHT backend can learn potential initial bootstrapping points through the instances mentioned in the received AP-relay messages
 -- persist them on disk so they can be used for all following bootstraps