adjust lookup to RingMap, fix #48

- change default lookup result when not joined to FOUND
- fix determining own responsibility #48
- adjust tests

src/Hash2Pub/DHTProtocol.hs

@@ -60,11 +60,16 @@ import           Hash2Pub.FediChordTypes        (CacheEntry (..),
                                                  NodeID, NodeState (..),
                                                  RemoteNodeState (..),
                                                  RingEntry (..), RingMap (..),
+                                                 HasKeyID(..),
                                                  addRMapEntryWith,
+                                                 addRMapEntry,
                                                  cacheGetNodeStateUnvalidated,
                                                  cacheLookup, cacheLookupPred,
                                                  cacheLookupSucc, localCompare,
                                                  localCompare, setPredecessors,
+                                                 getKeyID, rMapFromList,
+                                                 rMapLookupPred,
+                                                 rMapLookupSucc,
                                                  setSuccessors)
 import           Hash2Pub.ProtocolTypes
 
@@ -77,7 +82,7 @@ import           Debug.Trace                    (trace)
 queryLocalCache :: LocalNodeState -> NodeCache -> Int -> NodeID -> QueryResponse
 queryLocalCache ownState nCache lBestNodes targetID
     -- as target ID falls between own ID and first predecessor, it is handled by this node
-      | (targetID `localCompare`  ownID) `elem` [LT, EQ] && maybe False (\p -> targetID `localCompare` p  == GT) (getNid <$> headMay preds) = FOUND . toRemoteNodeState $ ownState
+      | isInOwnResponsibilitySlice ownState targetID = FOUND . toRemoteNodeState $ 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 $ closestSuccessor `Set.union` closestPredecessors
@@ -89,7 +94,7 @@ queryLocalCache ownState nCache lBestNodes targetID
     closestSuccessor = maybe Set.empty (Set.singleton . toRemoteCacheEntry) $ cacheLookupSucc targetID nCache
 
     closestPredecessors :: Set.Set RemoteCacheEntry
-    closestPredecessors = closestPredecessor (lBestNodes-1) $ getNid ownState
+    closestPredecessors = closestPredecessor (lBestNodes-1) targetID
     closestPredecessor :: (Integral n, Show n) => n -> NodeID -> Set.Set RemoteCacheEntry
     closestPredecessor 0 _ = Set.empty
     closestPredecessor remainingLookups lastID
@@ -101,6 +106,19 @@ queryLocalCache ownState nCache lBestNodes targetID
           Nothing -> Set.empty
           Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns)
 
+-- | Determines whether a lookup key is within the responsibility slice of a node,
+-- as it falls between its first predecessor and the node itself.
+-- Looks up the successor of the lookup key on a 'RingMap' representation of the
+-- predecessor list with the node itself added. If the result is the same as the node
+-- itself then it falls into the responsibility interval.
+isInOwnResponsibilitySlice :: HasKeyID a => LocalNodeState -> a -> Bool
+isInOwnResponsibilitySlice ownNs lookupTarget = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget) predecessorRMap) == pure (getNid ownNs)
+  where
+    predecessorList = predecessors ownNs
+    -- add node itself to RingMap representation, to distinguish between
+    -- responsibility of own node and predecessor
+    predecessorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList predecessorList
+    closestPredecessor = headMay predecessorList
 
 -- cache operations
 

src/Hash2Pub/FediChordTypes.hs

@@ -18,12 +18,18 @@ module Hash2Pub.FediChordTypes (
   , CacheEntry(..)
   , RingEntry(..)
   , RingMap(..)
+  , HasKeyID
+                               , getKeyID
   , rMapSize
+  , rMapLookup
+  , rMapLookupPred
+  , rMapLookupSucc
   , addRMapEntry
   , addRMapEntryWith
   , takeRMapPredecessors
   , takeRMapSuccessors
   , deleteRMapEntry
+  , setRMapEntries
                                , rMapFromList
                                , rMapToList
   , cacheGetNodeStateUnvalidated
@@ -251,6 +257,9 @@ instance HasKeyID RemoteNodeState where
 instance HasKeyID CacheEntry where
     getKeyID (CacheEntry _ ns _) = getNid ns
 
+instance HasKeyID NodeID where
+    getKeyID = id
+
 type NodeCache = RingMap CacheEntry
 
 -- | generic data structure for holding elements with a key and modular lookup
@@ -260,7 +269,7 @@ instance (HasKeyID a) => Eq (RingMap a) where
     a == b = getRingMap a == getRingMap b
 
 instance (HasKeyID a) => Show (RingMap a) where
-    show rmap = shows (getRingMap rmap) "RingMap "
+    show rmap = shows "RingMap " (show $ getRingMap rmap)
 
 -- | entry of a 'RingMap' that holds a value and can also
 -- wrap around the lookup direction at the edges of the name space.
@@ -459,8 +468,6 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $
       Nothing -> []
       Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry]
   where
-    -- TODO: figure out correct type signature once it compiles
-    --takeEntriesUntil :: (HasKeyID b, Integral i) => NodeID -> NodeID -> i -> [b] -> [b]
     takeEntriesUntil havingReached previousEntry remaining takeAcc
       | remaining <= 0 = takeAcc
       | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc

test/FediChordSpec.hs

@@ -127,28 +127,30 @@ spec = do
             node3 = exampleNodeState { nid = nid3}
             nid4 = toNodeID 2^(9::Integer)+100
             node4 = exampleNodeState { nid = nid4}
-            cacheWith2Entries :: IO NodeCache
+            nid5 = toNodeID 2^(25::Integer)+100
-            cacheWith2Entries = addCacheEntryPure 10 <$> (RemoteCacheEntry <$> (toRemoteNodeState <$> node1) <*> pure 10) <*> pure (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
+            node5 = exampleNodeState { nid = nid5}
-            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) <$> (addCacheEntryPure 10 (RemoteCacheEntry node4 10) <$> cacheWith2Entries)
+            cacheWith2Entries :: NodeCache
-        it "works on an empty cache" $ do
+            cacheWith2Entries = addCacheEntryPure 10 (RemoteCacheEntry node5 10) (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
-            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FORWARD Set.empty
+            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) (addCacheEntryPure 10 (RemoteCacheEntry node4 10) cacheWith2Entries)
-            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FORWARD Set.empty
+        it "nodes not joined provide the default answer FOUND" $ do
+            exampleLocalNodeAsRemote <- toRemoteNodeState <$> exampleLocalNode
+            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FOUND exampleLocalNodeAsRemote
+            queryLocalCache <$> exampleLocalNode <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FOUND exampleLocalNodeAsRemote
+        it "joined nodes do not fall back to the default" $
+            queryLocalCache <$> node1 <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 3) `shouldReturn` FORWARD Set.empty
         it "works on a cache with less entries than needed" $ do
-            (FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset) <- queryLocalCache <$> node1 <*> pure cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
+            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid5, nid2 ]
         it "works on a cache with sufficient entries" $ do
-            (FORWARD nodeset1) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset1) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
-            (FORWARD nodeset2) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset2) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3]
+            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid5]
             Set.map (nid . remoteNode) nodeset2 `shouldBe` Set.fromList [nid4]
         it "recognises the node's own responsibility" $ do
-            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure nid1
+            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure nid1
             getNid <$> node1 `shouldReturn` getNid selfQueryRes
-            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
+            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
             getNid <$> node1 `shouldReturn` getNid responsibilityResult
-        it "does not fail on nodes without neighbours (initial state)" $ do
-            (FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 11)
-            Set.map (nid . remoteNode ) nodeset `shouldBe` Set.fromList [nid4, nid2, nid3]
     describe "successors and predecessors do not disturb the ring characteristics of EpiChord operations (see #48)" $ do
         let
             emptyCache = initCache