fix infinite loops during lookups

This commit is contained in:
Trolli Schmittlauch 2020-04-16 01:02:33 +02:00
parent 18bdcce266
commit a803751213

View file

@ -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 f key cache =
case snd <$> f key cache of
lookupWrapper :: (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> ProxyDirection -> NodeID -> NodeCache -> Maybe CacheEntry
lookupWrapper f fRepeat direction key cache =
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