schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

generalise NodeCache implementation to make it usable for neighbour nodes as well

Browse source 
contributes to #48
This commit is contained in:
Trolli Schmittlauch 2020-06-13 21:41:23 +02:00
parent 7612f5532a
commit b179357ab0
1 changed files with 79 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
src/Hash2Pub/FediChordTypes.hs
View file

@ -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"