fix infinite loops during lookups

Hash2Pub/src/Hash2Pub/FediChord.hs

@@ -35,6 +35,7 @@ import qualified Data.Map.Strict as Map
 import Network.Socket
 import Data.Time.Clock
 import Control.Exception
+import Data.Maybe (isJust)
 
 -- for hashing and ID conversion
 import Crypto.Hash
@@ -47,6 +48,8 @@ import qualified Data.ByteArray as BA
 
 import Hash2Pub.Utils
 
+import Debug.Trace (trace)
+
 -- define protocol constants
 -- | static definition of ID length in bits
 idBits :: Integer
@@ -139,13 +142,22 @@ data CacheEntry =
     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)
+  | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
     deriving (Show, Eq)
 
+data ProxyDirection = Backwards | Forwards deriving (Show, Eq)
+
+instance Enum ProxyDirection where
+    toEnum (-1) = Backwards
+    toEnum 1 = Forwards
+    toEnum _ = error "no such ProxyDirection"
+    fromEnum Backwards = - 1
+    fromEnum Forwards = 1
+
 -- | 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)]
+initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
   where
     proxyEntry (from,to) = (from, ProxyEntry to Nothing)
 
@@ -185,18 +197,30 @@ cacheLookup key cache = case Map.lookup key cache of
 
 -- | 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 :: (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> ProxyDirection -> NodeID -> NodeCache -> Maybe CacheEntry
-lookupWrapper f key cache =
+lookupWrapper f fRepeat direction key cache =
-    case snd <$> f key cache of
+    case f key cache of
         -- the proxy entry found holds a
-        Just (ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry
+        Just (_, (ProxyEntry _ (Just entry@NodeEntry{}))) -> Just entry
         -- proxy entry holds another proxy entry, this should not happen
-        Just (ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing
+        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
+        -- if lookup direction is the same as pointer direction: follow pointer
+        Just (foundKey, (ProxyEntry (pointerID, pointerDirection) Nothing)) ->
+            let newKey = if pointerDirection == direction
+                            then pointerID
+                            else foundKey + (fromInteger . toInteger . fromEnum $ direction)
+            in if cacheNotEmpty cache
+               then lookupWrapper fRepeat fRepeat direction newKey cache
+               else Nothing
         -- normal entries are returned
-        Just entry@NodeEntry{}  -> Just entry
+        Just (_, entry@NodeEntry{}) -> Just entry
         Nothing -> Nothing
+  where
+    cacheNotEmpty :: NodeCache -> Bool
+    cacheNotEmpty cache' = (Map.size cache' > 2)     -- there are more than the 2 ProxyEntries
+                   || isJust ( cacheLookup minBound cache') -- or one of the ProxyEntries holds a node
+                   || isJust (cacheLookup maxBound cache')
 
 -- | 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,
@@ -204,13 +228,13 @@ lookupWrapper f key cache =
 cacheLookupSucc :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe CacheEntry
-cacheLookupSucc = lookupWrapper Map.lookupGE
+cacheLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
 
 -- | 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
+cacheLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
 
 -- clean up cache entries: once now - entry > maxAge
 -- transfer difference now - entry to other node