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

@@ -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' 

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.
+-- | 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
-    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
 data NodeState = NodeState {
@@ -124,28 +133,93 @@ data NodeState = NodeState {
 
 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
     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

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
+        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
                 a = toNodeID 3
                 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
-            (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"
             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