src/Hash2Pub/DHTProtocol.hs

@@ -60,16 +60,11 @@ 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
 
@@ -82,7 +77,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
-      | isInOwnResponsibilitySlice ownState targetID = FOUND . toRemoteNodeState $ ownState
+      | (targetID `localCompare`  ownID) `elem` [LT, EQ] && maybe False (\p -> targetID `localCompare` p  == GT) (getNid <$> headMay preds) = 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
@@ -94,7 +89,7 @@ queryLocalCache ownState nCache lBestNodes targetID
     closestSuccessor = maybe Set.empty (Set.singleton . toRemoteCacheEntry) $ cacheLookupSucc targetID nCache
 
     closestPredecessors :: Set.Set RemoteCacheEntry
-    closestPredecessors = closestPredecessor (lBestNodes-1) targetID
+    closestPredecessors = closestPredecessor (lBestNodes-1) $ getNid ownState
     closestPredecessor :: (Integral n, Show n) => n -> NodeID -> Set.Set RemoteCacheEntry
     closestPredecessor 0 _ = Set.empty
     closestPredecessor remainingLookups lastID
@@ -106,19 +101,6 @@ 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,18 +18,12 @@ module Hash2Pub.FediChordTypes (
   , CacheEntry(..)
   , RingEntry(..)
   , RingMap(..)
-  , HasKeyID
-                               , getKeyID
   , rMapSize
-  , rMapLookup
-  , rMapLookupPred
-  , rMapLookupSucc
   , addRMapEntry
   , addRMapEntryWith
   , takeRMapPredecessors
   , takeRMapSuccessors
   , deleteRMapEntry
-  , setRMapEntries
                                , rMapFromList
                                , rMapToList
   , cacheGetNodeStateUnvalidated
@@ -257,9 +251,6 @@ 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
@@ -269,7 +260,7 @@ instance (HasKeyID a) => Eq (RingMap a) where
     a == b = getRingMap a == getRingMap b
 
 instance (HasKeyID a) => Show (RingMap a) where
-    show rmap = shows "RingMap " (show $ getRingMap rmap)
+    show rmap = shows (getRingMap rmap) "RingMap "
 
 -- | entry of a 'RingMap' that holds a value and can also
 -- wrap around the lookup direction at the edges of the name space.
@@ -468,6 +459,8 @@ 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,30 +127,28 @@ spec = do
             node3 = exampleNodeState { nid = nid3}
             nid4 = toNodeID 2^(9::Integer)+100
             node4 = exampleNodeState { nid = nid4}
-            nid5 = toNodeID 2^(25::Integer)+100
+            cacheWith2Entries :: IO NodeCache
-            node5 = exampleNodeState { nid = nid5}
+            cacheWith2Entries = addCacheEntryPure 10 <$> (RemoteCacheEntry <$> (toRemoteNodeState <$> node1) <*> pure 10) <*> pure (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
-            cacheWith2Entries :: NodeCache
+            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) <$> (addCacheEntryPure 10 (RemoteCacheEntry node4 10) <$> cacheWith2Entries)
-            cacheWith2Entries = addCacheEntryPure 10 (RemoteCacheEntry node5 10) (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
+        it "works on an empty cache" $ do
-            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) (addCacheEntryPure 10 (RemoteCacheEntry node4 10) cacheWith2Entries)
+            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FORWARD Set.empty
-        it "nodes not joined provide the default answer FOUND" $ do
+            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FORWARD Set.empty
-            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 <$> node1 <*> pure cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid5, nid2 ]
+            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
         it "works on a cache with sufficient entries" $ do
-            (FORWARD nodeset1) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset1) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
-            (FORWARD nodeset2) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset2) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid5]
+            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3]
             Set.map (nid . remoteNode) nodeset2 `shouldBe` Set.fromList [nid4]
         it "recognises the node's own responsibility" $ do
-            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure nid1
+            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure nid1
             getNid <$> node1 `shouldReturn` getNid selfQueryRes
-            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
+            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> 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