diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index d775f9f..f887095 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -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')