From b179357ab0f3de877543e6f95de101c758af56ba Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Sat, 13 Jun 2020 21:41:23 +0200 Subject: [PATCH] generalise NodeCache implementation to make it usable for neighbour nodes as well contributes to #48 --- src/Hash2Pub/FediChordTypes.hs | 112 +++++++++++++++++++++++---------- 1 file changed, 79 insertions(+), 33 deletions(-) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index a599739..d775f9f 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -150,6 +150,7 @@ data LocalNodeState = LocalNodeState } deriving (Show, Eq) +-- | for concurrent access, LocalNodeState is wrapped in a TVar type LocalNodeStateSTM = TVar LocalNodeState -- | class for various NodeState representations, providing @@ -224,22 +225,39 @@ setSuccessors succ' ns = ns {successors = take (kNeighbours ns) . nub . sortBy ( setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState setPredecessors pred' ns = ns {predecessors = take (kNeighbours ns) . nub . sortBy (flip localCompare `on` getNid) . filter ((== GT) . (localCompare `on` getNid) (toRemoteNodeState ns)) $ pred'} -type NodeCache = Map.Map NodeID CacheEntry +-- | Class for all types that can be identified via an EpiChord key. +-- Used for restricting the types a 'RingMap' can store +class HasKeyID a where + getKeyID :: a -> NodeID + +instance HasKeyID RemoteNodeState where + getKeyID = getNid + +instance HasKeyID CacheEntry where + getKeyID (CacheEntry _ ns _) = getNid ns + +type NodeCache = RingMap CacheEntry + +-- | generic data structure for holding elements with a key and modular lookup +newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } deriving (Show, Eq) -- | An entry of the 'nodeCache' can hold 2 different kinds of data. -- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here. -data CacheEntry = NodeEntry Bool RemoteNodeState POSIXTime - | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry) +data RingEntry a = KeyEntry a + | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a)) deriving (Show, Eq) --- | as a compromise, only NodeEntry components are ordered by their NodeID --- while ProxyEntry components should never be tried to be ordered. -instance Ord CacheEntry where +-- | 'RingEntry' type for usage as a node cache +data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime + +-- | as a compromise, only KeyEntry components are ordered by their NodeID +-- while ProxyEntry components should never be tried to be ordered. +instance Ord RingEntry where a `compare` b = compare (extractID a) (extractID b) where - extractID (NodeEntry _ eState _) = getNid eState - extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache" + extractID (KeyEntry e) = getKeyID e + extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" data ProxyDirection = Backwards | Forwards @@ -254,32 +272,48 @@ instance Enum ProxyDirection where --- useful function for getting entries for a full cache transfer cacheEntries :: NodeCache -> [CacheEntry] -cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache +cacheEntries = mapMaybe extractNodeEntries . Map.elems . getRingMap where extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry + extractNodeEntries (KeyEntry entry) = Just entry -- | 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, Forwards)), (minBound, (maxBound, Backwards))] +initRMap :: HasKeyID a => RingMap a +initRMap = RingMap . Map.fromList . proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] where proxyEntry (from,to) = (from, ProxyEntry to Nothing) --- | Maybe returns the cache entry stored at given key -cacheLookup :: NodeID -- ^lookup key - -> NodeCache -- ^lookup cache - -> Maybe CacheEntry -cacheLookup key cache = case Map.lookup key cache of +initCache :: NodeCache +initCache = initRingMap + +-- | Maybe returns the entry stored at given key +rMapLookup :: HasKeyID a + => NodeID -- ^lookup key + -> RingMap a -- ^lookup cache + -> Maybe a +rMapLookup key rmap = case Map.lookup key $ getRingMap rmap of Just (ProxyEntry _ result) -> result res -> res +cacheLookup :: NodeID -- ^lookup key + -> NodeCache -- ^lookup cache + -> Maybe CacheEntry +cacheLookup = rMapLookup + -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ -- to simulate a modular ring -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 +lookupWrapper :: HasKeyID a + => (NodeID -> Map.Map NodeID a -> Maybe (NodeID, a)) + -> (NodeID -> Map.Map NodeID a -> Maybe (NodeID, a)) + -> ProxyDirection + -> NodeID + -> RingMap a + -> Maybe a +lookupWrapper f fRepeat direction key rmap = + case f key $ getRingMap rmap of -- the proxy entry found holds a - Just (_, ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry + Just (_, ProxyEntry _ (Just entry@KeyEntry{})) -> Just entry -- proxy entry holds another proxy entry, this should not happen Just (_, ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing -- proxy entry without own entry is a pointer on where to continue @@ -288,38 +322,50 @@ lookupWrapper f fRepeat direction key cache = let newKey = if pointerDirection == direction then pointerID else foundKey + (fromInteger . toInteger . fromEnum $ direction) - in if cacheNotEmpty cache - then lookupWrapper fRepeat fRepeat direction newKey cache + in if rMapNotEmpty rmap + then lookupWrapper fRepeat fRepeat direction newKey rmap else Nothing -- normal entries are returned - Just (_, entry@NodeEntry{}) -> Just entry + Just (_, entry@KeyEntry{}) -> 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') + rMapNotEmpty :: RingMap a -> Bool + rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2) -- there are more than the 2 ProxyEntries + || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node + || isJust (rMapLookup maxBound rmap') --- | find the successor node to a given key on a modular EpiChord ring cache. +-- | find the successor node to a given key on a modular EpiChord ring. -- Note: The EpiChord definition of "successor" includes the node at the key itself, -- if existing. +rMapLookupSucc :: HasKeyID a + => NodeID -- ^lookup key + -> RingMap a -- ^ring cache + -> Maybe a +rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards + cacheLookupSucc :: NodeID -- ^lookup key -> NodeCache -- ^ring cache -> Maybe CacheEntry -cacheLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards +cacheLookupSucc = rMapLookupSucc + +-- | find the predecessor node to a given key on a modular EpiChord ring. +rMapLookupPred :: HasKeyID a + => NodeID -- ^lookup key + -> RingMap a -- ^ring cache + -> Maybe a +rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards --- | 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 Map.lookupLE Backwards +cacheLookupPred = rMapLookupPred -- clean up cache entries: once now - entry > maxAge -- transfer difference now - entry to other node -- | return the @NodeState@ data from a cache entry without checking its validation status -cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState -cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState +cacheGetNodeStateUnvalidated :: RingEntry CacheEntry -> RemoteNodeState +cacheGetNodeStateUnvalidated (KeyEntry (CacheEntry _ nState _)) = nState cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug"