diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index 677fab4..d4902e9 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/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 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