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