forked from schmittlauch/Hash2Pub
fix RingMap function types
This commit is contained in:
parent
b179357ab0
commit
6a98b5c6da
|
@ -2,6 +2,7 @@
|
|||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Hash2Pub.FediChordTypes (
|
||||
NodeID -- abstract, but newtype constructors cannot be hidden
|
||||
|
@ -239,7 +240,7 @@ instance HasKeyID CacheEntry where
|
|||
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)
|
||||
newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
|
||||
|
||||
-- | 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.
|
||||
|
@ -253,7 +254,7 @@ 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
|
||||
instance (HasKeyID a, Eq a) => Ord (RingEntry a) where
|
||||
a `compare` b = compare (extractID a) (extractID b)
|
||||
where
|
||||
extractID (KeyEntry e) = getKeyID e
|
||||
|
@ -274,18 +275,20 @@ instance Enum ProxyDirection where
|
|||
cacheEntries :: NodeCache -> [CacheEntry]
|
||||
cacheEntries = mapMaybe extractNodeEntries . Map.elems . getRingMap
|
||||
where
|
||||
extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
|
||||
extractNodeEntries (KeyEntry entry) = Just entry
|
||||
extractNodeEntries :: RingEntry CacheEntry -> Maybe CacheEntry
|
||||
extractNodeEntries (ProxyEntry _ (Just (KeyEntry entry))) = Just entry
|
||||
extractNodeEntries (KeyEntry entry) = Just entry
|
||||
extractNodeEntries _ = Nothing
|
||||
|
||||
-- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
|
||||
-- linking the modular name space together by connecting @minBound@ and @maxBound@
|
||||
initRMap :: HasKeyID a => RingMap a
|
||||
initRMap = RingMap . Map.fromList . proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
|
||||
initRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
|
||||
where
|
||||
proxyEntry (from,to) = (from, ProxyEntry to Nothing)
|
||||
|
||||
initCache :: NodeCache
|
||||
initCache = initRingMap
|
||||
initCache = initRMap
|
||||
|
||||
-- | Maybe returns the entry stored at given key
|
||||
rMapLookup :: HasKeyID a
|
||||
|
@ -293,8 +296,9 @@ rMapLookup :: HasKeyID a
|
|||
-> RingMap a -- ^lookup cache
|
||||
-> Maybe a
|
||||
rMapLookup key rmap = case Map.lookup key $ getRingMap rmap of
|
||||
Just (ProxyEntry _ result) -> result
|
||||
res -> res
|
||||
Just (ProxyEntry _ (Just (KeyEntry result))) -> Just result
|
||||
Just (KeyEntry res) -> Just res
|
||||
_ -> Nothing
|
||||
|
||||
cacheLookup :: NodeID -- ^lookup key
|
||||
-> NodeCache -- ^lookup cache
|
||||
|
@ -304,8 +308,8 @@ cacheLookup = rMapLookup
|
|||
-- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
|
||||
-- to simulate a modular ring
|
||||
lookupWrapper :: HasKeyID a
|
||||
=> (NodeID -> Map.Map NodeID a -> Maybe (NodeID, a))
|
||||
-> (NodeID -> Map.Map NodeID a -> Maybe (NodeID, a))
|
||||
=> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
|
||||
-> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
|
||||
-> ProxyDirection
|
||||
-> NodeID
|
||||
-> RingMap a
|
||||
|
@ -313,7 +317,7 @@ lookupWrapper :: HasKeyID a
|
|||
lookupWrapper f fRepeat direction key rmap =
|
||||
case f key $ getRingMap rmap of
|
||||
-- the proxy entry found holds a
|
||||
Just (_, ProxyEntry _ (Just entry@KeyEntry{})) -> Just entry
|
||||
Just (_, ProxyEntry _ (Just (KeyEntry entry))) -> 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
|
||||
|
@ -326,10 +330,10 @@ lookupWrapper f fRepeat direction key rmap =
|
|||
then lookupWrapper fRepeat fRepeat direction newKey rmap
|
||||
else Nothing
|
||||
-- normal entries are returned
|
||||
Just (_, entry@KeyEntry{}) -> Just entry
|
||||
Just (_, (KeyEntry entry)) -> Just entry
|
||||
Nothing -> Nothing
|
||||
where
|
||||
rMapNotEmpty :: RingMap a -> Bool
|
||||
rMapNotEmpty :: (HasKeyID a) => 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')
|
||||
|
|
Loading…
Reference in a new issue