From 1ff540fd6891cd9c9b879dbc7763ceabb8a7354b Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Sat, 25 Jul 2020 01:57:38 +0200 Subject: [PATCH 1/3] refactor RingMap into own module --- Hash2Pub.cabal | 4 +- src/Hash2Pub/FediChordTypes.hs | 209 +------------------------------- src/Hash2Pub/RingMap.hs | 213 +++++++++++++++++++++++++++++++++ 3 files changed, 216 insertions(+), 210 deletions(-) create mode 100644 src/Hash2Pub/RingMap.hs diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index 624cb9b..ebc9c7e 100644 --- a/Hash2Pub.cabal +++ b/Hash2Pub.cabal @@ -46,7 +46,7 @@ category: Network extra-source-files: CHANGELOG.md common deps - build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, http-api-data + build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, unordered-containers ghc-options: -Wall @@ -55,7 +55,7 @@ library import: deps -- Modules exported by the library. - exposed-modules: Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes, Hash2Pub.PostService, Hash2Pub.ServiceTypes + exposed-modules: Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes, Hash2Pub.PostService, Hash2Pub.ServiceTypes, Hash2Pub.RingMap -- Modules included in this library but not exported. other-modules: Hash2Pub.Utils diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index 6511db6..a135e80 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -84,6 +84,7 @@ import Data.Typeable (Typeable (..), typeOf) import Data.Word import qualified Network.ByteOrder as NetworkBytes +import Hash2Pub.RingMap import Hash2Pub.Utils import Debug.Trace (trace) @@ -282,11 +283,6 @@ addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) ( addSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries (filter ((/=) (getNid ns) . getNid) succs) . rMapFromList $ successors ns} --- | Class for all types that can be identified via an EpiChord key. --- Used for restricting the types a 'RingMap' can store -class (Eq a, Show a) => HasKeyID a where - getKeyID :: a -> NodeID - instance HasKeyID RemoteNodeState where getKeyID = getNid @@ -302,235 +298,32 @@ type NodeCache = RingMap NodeCacheEntry type LookupCacheEntry = CacheEntry (String, PortNumber) type LookupCache = Map.Map NodeID LookupCacheEntry --- | generic data structure for holding elements with a key and modular lookup -newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } - -instance (HasKeyID a) => Eq (RingMap a) where - a == b = getRingMap a == getRingMap b - -instance (HasKeyID a) => Show (RingMap a) where - show rmap = shows "RingMap " (show $ getRingMap rmap) - --- | entry of a 'RingMap' that holds a value and can also --- wrap around the lookup direction at the edges of the name space. -data RingEntry a = KeyEntry a - | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a)) - deriving (Show, Eq) - -- | 'RingEntry' type for usage as a node cache data CacheEntry a = CacheEntry Bool a POSIXTime deriving (Show, Eq) - --- | as a compromise, only KeyEntry components are ordered by their NodeID --- while ProxyEntry components should never be tried to be ordered. -instance (HasKeyID a, Eq a) => Ord (RingEntry a) where - a `compare` b = compare (extractID a) (extractID b) - where - extractID (KeyEntry e) = getKeyID e - extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" - -data ProxyDirection = Backwards - | Forwards - deriving (Show, Eq) - -instance Enum ProxyDirection where - toEnum (-1) = Backwards - toEnum 1 = Forwards - toEnum _ = error "no such ProxyDirection" - fromEnum Backwards = - 1 - fromEnum Forwards = 1 - --- | helper function for getting the a from a RingEntry a -extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a -extractRingEntry (KeyEntry entry) = Just entry -extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry -extractRingEntry _ = Nothing - --- useful function for getting entries for a full cache transfer nodeCacheEntries :: NodeCache -> [NodeCacheEntry] nodeCacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap --- | An empty 'RingMap' needs to be initialised with 2 proxy entries, --- linking the modular name space together by connecting @minBound@ and @maxBound@ -emptyRMap :: HasKeyID a => RingMap a -emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] - where - proxyEntry (from,to) = (from, ProxyEntry to Nothing) - initCache :: NodeCache initCache = emptyRMap --- | Maybe returns the entry stored at given key -rMapLookup :: HasKeyID a - => NodeID -- ^lookup key - -> RingMap a -- ^lookup cache - -> Maybe a -rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) - cacheLookup :: NodeID -- ^lookup key -> NodeCache -- ^lookup cache -> Maybe NodeCacheEntry cacheLookup = rMapLookup --- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' -rMapSize :: (HasKeyID a, Integral i) - => RingMap a - -> i -rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound - where - innerMap = getRingMap rmap - oneIfEntry :: Integral i => NodeID -> i - oneIfEntry nid - | isNothing (rMapLookup nid rmap) = 1 - | otherwise = 0 - --- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ --- to simulate a modular ring -lookupWrapper :: HasKeyID 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 - -> Maybe a -lookupWrapper f fRepeat direction key rmap = - case f key $ getRingMap rmap of - -- the proxy entry found holds a - 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 - -- if lookup direction is the same as pointer direction: follow pointer - Just (foundKey, ProxyEntry (pointerID, pointerDirection) Nothing) -> - let newKey = if pointerDirection == direction - then pointerID - else foundKey + (fromInteger . toInteger . fromEnum $ direction) - in if rMapNotEmpty rmap - then lookupWrapper fRepeat fRepeat direction newKey rmap - else Nothing - -- normal entries are returned - Just (_, KeyEntry entry) -> Just entry - Nothing -> Nothing - where - 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') - --- | 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 NodeCacheEntry 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 - cacheLookupPred :: NodeID -- ^lookup key -> NodeCache -- ^ring cache -> Maybe NodeCacheEntry cacheLookupPred = rMapLookupPred -addRMapEntryWith :: HasKeyID a - => (RingEntry a -> RingEntry a -> RingEntry a) - -> a - -> RingMap a - -> RingMap a -addRMapEntryWith combineFunc entry = RingMap - . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) - . getRingMap - -addRMapEntry :: HasKeyID a - => a - -> RingMap a - -> RingMap a -addRMapEntry = addRMapEntryWith insertCombineFunction - where - insertCombineFunction newVal oldVal = - case oldVal of - ProxyEntry n _ -> ProxyEntry n (Just newVal) - KeyEntry _ -> newVal - - -addRMapEntries :: (Foldable t, HasKeyID a) - => t a - -> RingMap a - -> RingMap a -addRMapEntries entries rmap = foldr' addRMapEntry rmap entries - -setRMapEntries :: (Foldable t, HasKeyID a) - => t a - -> RingMap a -setRMapEntries entries = addRMapEntries entries emptyRMap - -deleteRMapEntry :: (HasKeyID a) - => NodeID - -> RingMap a - -> RingMap a -deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap - where - modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) - modifier KeyEntry {} = Nothing - -rMapToList :: (HasKeyID a) => RingMap a -> [a] -rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap - -rMapFromList :: (HasKeyID a) => [a] -> RingMap a -rMapFromList = setRMapEntries - --- | takes up to i entries from a 'RingMap' by calling a getter function on a --- *startAt* value and after that on the previously returned value. --- Stops once i entries have been taken or an entry has been encountered twice --- (meaning the ring has been traversed completely). --- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'. -takeRMapEntries_ :: (HasKeyID a, Integral i) - => (NodeID -> RingMap a -> Maybe a) - -> NodeID - -> i - -> RingMap a - -> [a] --- TODO: might be more efficient with dlists -takeRMapEntries_ getterFunc startAt num rmap = reverse $ - case getterFunc startAt rmap of - Nothing -> [] - Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] - where - takeEntriesUntil havingReached previousEntry remaining takeAcc - | remaining <= 0 = takeAcc - | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc - | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap - in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) - -takeRMapPredecessors :: (HasKeyID a, Integral i) - => NodeID - -> i - -> RingMap a - -> [a] -takeRMapPredecessors = takeRMapEntries_ rMapLookupPred - -takeRMapSuccessors :: (HasKeyID a, Integral i) - => NodeID - -> i - -> RingMap a - -> [a] -takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc - --- 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 -> RemoteNodeState cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs new file mode 100644 index 0000000..75698d6 --- /dev/null +++ b/src/Hash2Pub/RingMap.hs @@ -0,0 +1,213 @@ +module Hash2Pub.RingMap where + + +-- | Class for all types that can be identified via an EpiChord key. +-- Used for restricting the types a 'RingMap' can store +class (Eq a, Show a) => HasKeyID a where + getKeyID :: a -> NodeID + + +-- | generic data structure for holding elements with a key and modular lookup +newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } + +instance (HasKeyID a) => Eq (RingMap a) where + a == b = getRingMap a == getRingMap b + +instance (HasKeyID a) => Show (RingMap a) where + show rmap = shows "RingMap " (show $ getRingMap rmap) + +-- | entry of a 'RingMap' that holds a value and can also +-- wrap around the lookup direction at the edges of the name space. +data RingEntry a = KeyEntry a + | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a)) + deriving (Show, Eq) + +-- +-- | as a compromise, only KeyEntry components are ordered by their NodeID +-- while ProxyEntry components should never be tried to be ordered. +instance (HasKeyID a, Eq a) => Ord (RingEntry a) where + a `compare` b = compare (extractID a) (extractID b) + where + extractID (KeyEntry e) = getKeyID e + extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" + +data ProxyDirection = Backwards + | Forwards + deriving (Show, Eq) + +instance Enum ProxyDirection where + toEnum (-1) = Backwards + toEnum 1 = Forwards + toEnum _ = error "no such ProxyDirection" + fromEnum Backwards = - 1 + fromEnum Forwards = 1 + +-- | helper function for getting the a from a RingEntry a +extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a +extractRingEntry (KeyEntry entry) = Just entry +extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry +extractRingEntry _ = Nothing + +-- | An empty 'RingMap' needs to be initialised with 2 proxy entries, +-- linking the modular name space together by connecting @minBound@ and @maxBound@ +emptyRMap :: HasKeyID a => RingMap a +emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] + where + proxyEntry (from,to) = (from, ProxyEntry to Nothing) + +-- | Maybe returns the entry stored at given key +rMapLookup :: HasKeyID a + => NodeID -- ^lookup key + -> RingMap a -- ^lookup cache + -> Maybe a +rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) + +-- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' +rMapSize :: (HasKeyID a, Integral i) + => RingMap a + -> i +rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound + where + innerMap = getRingMap rmap + oneIfEntry :: Integral i => NodeID -> i + oneIfEntry nid + | isNothing (rMapLookup nid rmap) = 1 + | otherwise = 0 + +-- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ +-- to simulate a modular ring +lookupWrapper :: HasKeyID 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 + -> Maybe a +lookupWrapper f fRepeat direction key rmap = + case f key $ getRingMap rmap of + -- the proxy entry found holds a + 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 + -- if lookup direction is the same as pointer direction: follow pointer + Just (foundKey, ProxyEntry (pointerID, pointerDirection) Nothing) -> + let newKey = if pointerDirection == direction + then pointerID + else foundKey + (fromInteger . toInteger . fromEnum $ direction) + in if rMapNotEmpty rmap + then lookupWrapper fRepeat fRepeat direction newKey rmap + else Nothing + -- normal entries are returned + Just (_, KeyEntry entry) -> Just entry + Nothing -> Nothing + where + 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') + +-- | 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 + +-- | 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 + +addRMapEntryWith :: HasKeyID a + => (RingEntry a -> RingEntry a -> RingEntry a) + -> a + -> RingMap a + -> RingMap a +addRMapEntryWith combineFunc entry = RingMap + . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) + . getRingMap + +addRMapEntry :: HasKeyID a + => a + -> RingMap a + -> RingMap a +addRMapEntry = addRMapEntryWith insertCombineFunction + where + insertCombineFunction newVal oldVal = + case oldVal of + ProxyEntry n _ -> ProxyEntry n (Just newVal) + KeyEntry _ -> newVal + + +addRMapEntries :: (Foldable t, HasKeyID a) + => t a + -> RingMap a + -> RingMap a +addRMapEntries entries rmap = foldr' addRMapEntry rmap entries + +setRMapEntries :: (Foldable t, HasKeyID a) + => t a + -> RingMap a +setRMapEntries entries = addRMapEntries entries emptyRMap + +deleteRMapEntry :: (HasKeyID a) + => NodeID + -> RingMap a + -> RingMap a +deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap + where + modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) + modifier KeyEntry {} = Nothing + +rMapToList :: (HasKeyID a) => RingMap a -> [a] +rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap + +rMapFromList :: (HasKeyID a) => [a] -> RingMap a +rMapFromList = setRMapEntries + +-- | takes up to i entries from a 'RingMap' by calling a getter function on a +-- *startAt* value and after that on the previously returned value. +-- Stops once i entries have been taken or an entry has been encountered twice +-- (meaning the ring has been traversed completely). +-- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'. +takeRMapEntries_ :: (HasKeyID a, Integral i) + => (NodeID -> RingMap a -> Maybe a) + -> NodeID + -> i + -> RingMap a + -> [a] +-- TODO: might be more efficient with dlists +takeRMapEntries_ getterFunc startAt num rmap = reverse $ + case getterFunc startAt rmap of + Nothing -> [] + Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] + where + takeEntriesUntil havingReached previousEntry remaining takeAcc + | remaining <= 0 = takeAcc + | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc + | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap + in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) + +takeRMapPredecessors :: (HasKeyID a, Integral i) + => NodeID + -> i + -> RingMap a + -> [a] +takeRMapPredecessors = takeRMapEntries_ rMapLookupPred + +takeRMapSuccessors :: (HasKeyID a, Integral i) + => NodeID + -> i + -> RingMap a + -> [a] +takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc + +-- clean up cache entries: once now - entry > maxAge +-- transfer difference now - entry to other node + + -- 2.42.0 From 9a20a602224dffa141b161e07307fc27b7875604 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Sat, 25 Jul 2020 22:56:56 +0200 Subject: [PATCH 2/3] fix type constraints after RingMap refactor --- src/Hash2Pub/RingMap.hs | 148 ++++++++++++++++++++++------------------ 1 file changed, 82 insertions(+), 66 deletions(-) diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs index 75698d6..46aec5f 100644 --- a/src/Hash2Pub/RingMap.hs +++ b/src/Hash2Pub/RingMap.hs @@ -1,33 +1,39 @@ +{-# LANGUAGE RankNTypes #-} + module Hash2Pub.RingMap where +import Data.Foldable (foldr') +import qualified Data.Map.Strict as Map +import Data.Maybe (fromJust, isJust, isNothing, mapMaybe) + -- | Class for all types that can be identified via an EpiChord key. -- Used for restricting the types a 'RingMap' can store class (Eq a, Show a) => HasKeyID a where - getKeyID :: a -> NodeID + getKeyID :: (Bounded k, Ord k) => a -> k -- | generic data structure for holding elements with a key and modular lookup -newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } +newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a, Bounded k, Ord k) => Map.Map k (RingEntry a k) } -instance (HasKeyID a) => Eq (RingMap a) where +instance (HasKeyID a, Bounded k, Ord k) => Eq (RingMap a k) where a == b = getRingMap a == getRingMap b -instance (HasKeyID a) => Show (RingMap a) where +instance (HasKeyID a, Bounded k, Ord k, Show k) => Show (RingMap a k) where show rmap = shows "RingMap " (show $ getRingMap rmap) -- | entry of a 'RingMap' that holds a value and can also -- wrap around the lookup direction at the edges of the name space. -data RingEntry a = KeyEntry a - | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a)) +data RingEntry a k = KeyEntry a + | ProxyEntry (k, ProxyDirection) (Maybe (RingEntry a k)) deriving (Show, Eq) --- --- | as a compromise, only KeyEntry components are ordered by their NodeID +-- | as a compromise, only KeyEntry components are ordered by their key -- while ProxyEntry components should never be tried to be ordered. -instance (HasKeyID a, Eq a) => Ord (RingEntry a) where +instance (HasKeyID a, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where a `compare` b = compare (extractID a) (extractID b) where + extractID :: (HasKeyID a, Ord a, Bounded k, Ord k) => RingEntry a k -> k extractID (KeyEntry e) = getKeyID e extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" @@ -42,46 +48,46 @@ instance Enum ProxyDirection where fromEnum Backwards = - 1 fromEnum Forwards = 1 --- | helper function for getting the a from a RingEntry a -extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a +-- | helper function for getting the a from a RingEntry a k +extractRingEntry :: (HasKeyID a, Bounded k, Ord k) => RingEntry a k -> Maybe a extractRingEntry (KeyEntry entry) = Just entry extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry extractRingEntry _ = Nothing -- | An empty 'RingMap' needs to be initialised with 2 proxy entries, -- linking the modular name space together by connecting @minBound@ and @maxBound@ -emptyRMap :: HasKeyID a => RingMap a +emptyRMap :: (HasKeyID a, Bounded k, Ord k) => RingMap a k emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] where proxyEntry (from,to) = (from, ProxyEntry to Nothing) -- | Maybe returns the entry stored at given key -rMapLookup :: HasKeyID a - => NodeID -- ^lookup key - -> RingMap a -- ^lookup cache +rMapLookup :: (HasKeyID a, Bounded k, Ord k) + => k -- ^lookup key + -> RingMap a k -- ^lookup cache -> Maybe a rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) -- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' -rMapSize :: (HasKeyID a, Integral i) - => RingMap a +rMapSize :: (HasKeyID a, Integral i, Bounded k, Ord k) + => RingMap a k -> i -rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound +rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry rmap minBound - oneIfEntry rmap maxBound where innerMap = getRingMap rmap - oneIfEntry :: Integral i => NodeID -> i - oneIfEntry nid - | isNothing (rMapLookup nid rmap) = 1 + oneIfEntry :: (HasKeyID a, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i + oneIfEntry rmap' nid + | isNothing (rMapLookup nid rmap') = 1 | otherwise = 0 -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ -- to simulate a modular ring -lookupWrapper :: HasKeyID a - => (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a)) - -> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a)) +lookupWrapper :: (HasKeyID a, Bounded k, Ord k, Num k) + => (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) + -> (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) -> ProxyDirection - -> NodeID - -> RingMap a + -> k + -> RingMap a k -> Maybe a lookupWrapper f fRepeat direction key rmap = case f key $ getRingMap rmap of @@ -102,7 +108,7 @@ lookupWrapper f fRepeat direction key rmap = Just (_, KeyEntry entry) -> Just entry Nothing -> Nothing where - rMapNotEmpty :: (HasKeyID a) => RingMap a -> Bool + rMapNotEmpty :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> 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') @@ -110,32 +116,32 @@ lookupWrapper f fRepeat direction key rmap = -- | 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 +rMapLookupSucc :: (HasKeyID a, Bounded k, Ord k, Num k) + => k -- ^lookup key + -> RingMap a k -- ^ring cache -> Maybe a rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards -- | find the predecessor node to a given key on a modular EpiChord ring. -rMapLookupPred :: HasKeyID a - => NodeID -- ^lookup key - -> RingMap a -- ^ring cache +rMapLookupPred :: (HasKeyID a, Bounded k, Ord k, Num k) + => k -- ^lookup key + -> RingMap a k -- ^ring cache -> Maybe a rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards -addRMapEntryWith :: HasKeyID a - => (RingEntry a -> RingEntry a -> RingEntry a) +addRMapEntryWith :: (HasKeyID a, Bounded k, Ord k) + => (RingEntry a k -> RingEntry a k -> RingEntry a k) -> a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntryWith combineFunc entry = RingMap . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) . getRingMap -addRMapEntry :: HasKeyID a +addRMapEntry :: (HasKeyID a, Bounded k, Ord k) => a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntry = addRMapEntryWith insertCombineFunction where insertCombineFunction newVal oldVal = @@ -144,30 +150,30 @@ addRMapEntry = addRMapEntryWith insertCombineFunction KeyEntry _ -> newVal -addRMapEntries :: (Foldable t, HasKeyID a) +addRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) => t a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntries entries rmap = foldr' addRMapEntry rmap entries -setRMapEntries :: (Foldable t, HasKeyID a) +setRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) => t a - -> RingMap a + -> RingMap a k setRMapEntries entries = addRMapEntries entries emptyRMap -deleteRMapEntry :: (HasKeyID a) - => NodeID - -> RingMap a - -> RingMap a +deleteRMapEntry :: (HasKeyID a, Bounded k, Ord k) + => k + -> RingMap a k + -> RingMap a k deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap where modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) modifier KeyEntry {} = Nothing -rMapToList :: (HasKeyID a) => RingMap a -> [a] +rMapToList :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> [a] rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap -rMapFromList :: (HasKeyID a) => [a] -> RingMap a +rMapFromList :: (HasKeyID a, Bounded k, Ord k) => [a] -> RingMap a k rMapFromList = setRMapEntries -- | takes up to i entries from a 'RingMap' by calling a getter function on a @@ -175,35 +181,45 @@ rMapFromList = setRMapEntries -- Stops once i entries have been taken or an entry has been encountered twice -- (meaning the ring has been traversed completely). -- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'. -takeRMapEntries_ :: (HasKeyID a, Integral i) - => (NodeID -> RingMap a -> Maybe a) - -> NodeID +takeRMapEntries_ :: (HasKeyID a, Integral i, Bounded k, Ord k) + => (k -> RingMap a k -> Maybe a) + -> k -> i - -> RingMap a + -> RingMap a k -> [a] -- TODO: might be more efficient with dlists takeRMapEntries_ getterFunc startAt num rmap = reverse $ case getterFunc startAt rmap of Nothing -> [] - Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] + Just anEntry -> takeEntriesUntil rmap getterFunc (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] where - takeEntriesUntil havingReached previousEntry remaining takeAcc + -- for some reason, just reusing the already-bound @rmap@ and @getterFunc@ + -- variables leads to a type error, these need to be passed explicitly + takeEntriesUntil :: (HasKeyID a, Integral i, Bounded k, Ord k) + => RingMap a k + -> (k -> RingMap a k -> Maybe a) -- getter function + -> k + -> k + -> i + -> [a] + -> [a] + takeEntriesUntil rmap' getterFunc' havingReached previousEntry remaining takeAcc | remaining <= 0 = takeAcc - | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc - | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap - in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) + | getKeyID (fromJust $ getterFunc' previousEntry rmap') == havingReached = takeAcc + | otherwise = let (Just gotEntry) = getterFunc' previousEntry rmap' + in takeEntriesUntil rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) -takeRMapPredecessors :: (HasKeyID a, Integral i) - => NodeID +takeRMapPredecessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) + => k -> i - -> RingMap a + -> RingMap a k -> [a] takeRMapPredecessors = takeRMapEntries_ rMapLookupPred -takeRMapSuccessors :: (HasKeyID a, Integral i) - => NodeID +takeRMapSuccessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) + => k -> i - -> RingMap a + -> RingMap a k -> [a] takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc -- 2.42.0 From 0d1551261b949e42d64297aa9462b93e334cd662 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Sat, 25 Jul 2020 23:34:58 +0200 Subject: [PATCH 3/3] adjust code to refactored and parameterisable RingMap is a bit ugly due to FlexibleContexts being neede at several places --- src/Hash2Pub/DHTProtocol.hs | 12 ++++--- src/Hash2Pub/FediChordTypes.hs | 10 +++--- src/Hash2Pub/PostService.hs | 1 - src/Hash2Pub/RingMap.hs | 59 +++++++++++++++++----------------- 4 files changed, 43 insertions(+), 39 deletions(-) diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 9305f06..d69d94c 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + module Hash2Pub.DHTProtocol ( QueryResponse (..) , queryLocalCache @@ -128,8 +130,8 @@ closestCachePredecessors remainingLookups lastID nCache -- Looks up the successor of the lookup key on a 'RingMap' representation of the -- predecessor list with the node itself added. If the result is the same as the node -- itself then it falls into the responsibility interval. -isInOwnResponsibilitySlice :: HasKeyID a => a -> LocalNodeState -> Bool -isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget) predecessorRMap) == pure (getNid ownNs) +isInOwnResponsibilitySlice :: HasKeyID a NodeID => a -> LocalNodeState -> Bool +isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget :: NodeID) predecessorRMap) == pure (getNid ownNs) where predecessorList = predecessors ownNs -- add node itself to RingMap representation, to distinguish between @@ -137,11 +139,11 @@ isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (ge predecessorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList predecessorList closestPredecessor = headMay predecessorList -isPossiblePredecessor :: HasKeyID a => a -> LocalNodeState -> Bool +isPossiblePredecessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool isPossiblePredecessor = isInOwnResponsibilitySlice -isPossibleSuccessor :: HasKeyID a => a -> LocalNodeState -> Bool -isPossibleSuccessor lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget) successorRMap) == pure (getNid ownNs) +isPossibleSuccessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool +isPossibleSuccessor lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget :: NodeID) successorRMap) == pure (getNid ownNs) where successorList = successors ownNs successorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList successorList diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index a135e80..7652f4f 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -283,17 +285,17 @@ addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) ( addSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries (filter ((/=) (getNid ns) . getNid) succs) . rMapFromList $ successors ns} -instance HasKeyID RemoteNodeState where +instance HasKeyID RemoteNodeState NodeID where getKeyID = getNid -instance HasKeyID a => HasKeyID (CacheEntry a) where +instance HasKeyID a k => HasKeyID (CacheEntry a) k where getKeyID (CacheEntry _ obj _) = getKeyID obj -instance HasKeyID NodeID where +instance HasKeyID NodeID NodeID where getKeyID = id type NodeCacheEntry = CacheEntry RemoteNodeState -type NodeCache = RingMap NodeCacheEntry +type NodeCache = RingMap NodeCacheEntry NodeID type LookupCacheEntry = CacheEntry (String, PortNumber) type LookupCache = Map.Map NodeID LookupCacheEntry diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 53a840d..e8b325b 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -16,7 +16,6 @@ import qualified Data.Text as Txt import qualified Network.Wai.Handler.Warp as Warp import Servant -import Web.HttpApiData (showTextData) import Hash2Pub.FediChord import Hash2Pub.ServiceTypes diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs index 46aec5f..529a68b 100644 --- a/src/Hash2Pub/RingMap.hs +++ b/src/Hash2Pub/RingMap.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} module Hash2Pub.RingMap where @@ -7,19 +8,19 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromJust, isJust, isNothing, mapMaybe) --- | Class for all types that can be identified via an EpiChord key. +-- | Class for all types that can be identified via a EpiChord key. -- Used for restricting the types a 'RingMap' can store -class (Eq a, Show a) => HasKeyID a where - getKeyID :: (Bounded k, Ord k) => a -> k +class (Eq a, Show a, Bounded k, Ord k) => HasKeyID a k where + getKeyID :: a -> k -- | generic data structure for holding elements with a key and modular lookup -newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a, Bounded k, Ord k) => Map.Map k (RingEntry a k) } +newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a k, Bounded k, Ord k) => Map.Map k (RingEntry a k) } -instance (HasKeyID a, Bounded k, Ord k) => Eq (RingMap a k) where +instance (HasKeyID a k, Bounded k, Ord k) => Eq (RingMap a k) where a == b = getRingMap a == getRingMap b -instance (HasKeyID a, Bounded k, Ord k, Show k) => Show (RingMap a k) where +instance (HasKeyID a k, Bounded k, Ord k, Show k) => Show (RingMap a k) where show rmap = shows "RingMap " (show $ getRingMap rmap) -- | entry of a 'RingMap' that holds a value and can also @@ -30,10 +31,10 @@ data RingEntry a k = KeyEntry a -- | as a compromise, only KeyEntry components are ordered by their key -- while ProxyEntry components should never be tried to be ordered. -instance (HasKeyID a, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where +instance (HasKeyID a k, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where a `compare` b = compare (extractID a) (extractID b) where - extractID :: (HasKeyID a, Ord a, Bounded k, Ord k) => RingEntry a k -> k + extractID :: (HasKeyID a k, Ord a, Bounded k, Ord k) => RingEntry a k -> k extractID (KeyEntry e) = getKeyID e extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" @@ -49,40 +50,40 @@ instance Enum ProxyDirection where fromEnum Forwards = 1 -- | helper function for getting the a from a RingEntry a k -extractRingEntry :: (HasKeyID a, Bounded k, Ord k) => RingEntry a k -> Maybe a +extractRingEntry :: (HasKeyID a k, Bounded k, Ord k) => RingEntry a k -> Maybe a extractRingEntry (KeyEntry entry) = Just entry extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry extractRingEntry _ = Nothing -- | An empty 'RingMap' needs to be initialised with 2 proxy entries, -- linking the modular name space together by connecting @minBound@ and @maxBound@ -emptyRMap :: (HasKeyID a, Bounded k, Ord k) => RingMap a k +emptyRMap :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] where proxyEntry (from,to) = (from, ProxyEntry to Nothing) -- | Maybe returns the entry stored at given key -rMapLookup :: (HasKeyID a, Bounded k, Ord k) +rMapLookup :: (HasKeyID a k, Bounded k, Ord k) => k -- ^lookup key -> RingMap a k -- ^lookup cache -> Maybe a rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) -- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' -rMapSize :: (HasKeyID a, Integral i, Bounded k, Ord k) +rMapSize :: (HasKeyID a k, Integral i, Bounded k, Ord k) => RingMap a k -> i rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry rmap minBound - oneIfEntry rmap maxBound where innerMap = getRingMap rmap - oneIfEntry :: (HasKeyID a, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i + oneIfEntry :: (HasKeyID a k, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i oneIfEntry rmap' nid | isNothing (rMapLookup nid rmap') = 1 | otherwise = 0 -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ -- to simulate a modular ring -lookupWrapper :: (HasKeyID a, Bounded k, Ord k, Num k) +lookupWrapper :: (HasKeyID a k, Bounded k, Ord k, Num k) => (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) -> (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) -> ProxyDirection @@ -108,7 +109,7 @@ lookupWrapper f fRepeat direction key rmap = Just (_, KeyEntry entry) -> Just entry Nothing -> Nothing where - rMapNotEmpty :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> Bool + rMapNotEmpty :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> 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') @@ -116,20 +117,20 @@ lookupWrapper f fRepeat direction key rmap = -- | 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, Bounded k, Ord k, Num k) +rMapLookupSucc :: (HasKeyID a k, Bounded k, Ord k, Num k) => k -- ^lookup key -> RingMap a k -- ^ring cache -> Maybe a rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards -- | find the predecessor node to a given key on a modular EpiChord ring. -rMapLookupPred :: (HasKeyID a, Bounded k, Ord k, Num k) +rMapLookupPred :: (HasKeyID a k, Bounded k, Ord k, Num k) => k -- ^lookup key -> RingMap a k -- ^ring cache -> Maybe a rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards -addRMapEntryWith :: (HasKeyID a, Bounded k, Ord k) +addRMapEntryWith :: (HasKeyID a k, Bounded k, Ord k) => (RingEntry a k -> RingEntry a k -> RingEntry a k) -> a -> RingMap a k @@ -138,7 +139,7 @@ addRMapEntryWith combineFunc entry = RingMap . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) . getRingMap -addRMapEntry :: (HasKeyID a, Bounded k, Ord k) +addRMapEntry :: (HasKeyID a k, Bounded k, Ord k) => a -> RingMap a k -> RingMap a k @@ -150,18 +151,18 @@ addRMapEntry = addRMapEntryWith insertCombineFunction KeyEntry _ -> newVal -addRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) +addRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k) => t a -> RingMap a k -> RingMap a k addRMapEntries entries rmap = foldr' addRMapEntry rmap entries -setRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) +setRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k) => t a -> RingMap a k setRMapEntries entries = addRMapEntries entries emptyRMap -deleteRMapEntry :: (HasKeyID a, Bounded k, Ord k) +deleteRMapEntry :: (HasKeyID a k, Bounded k, Ord k) => k -> RingMap a k -> RingMap a k @@ -170,10 +171,10 @@ deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) modifier KeyEntry {} = Nothing -rMapToList :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> [a] +rMapToList :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> [a] rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap -rMapFromList :: (HasKeyID a, Bounded k, Ord k) => [a] -> RingMap a k +rMapFromList :: (HasKeyID a k, Bounded k, Ord k) => [a] -> RingMap a k rMapFromList = setRMapEntries -- | takes up to i entries from a 'RingMap' by calling a getter function on a @@ -181,7 +182,7 @@ rMapFromList = setRMapEntries -- Stops once i entries have been taken or an entry has been encountered twice -- (meaning the ring has been traversed completely). -- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'. -takeRMapEntries_ :: (HasKeyID a, Integral i, Bounded k, Ord k) +takeRMapEntries_ :: (HasKeyID a k, Integral i, Bounded k, Ord k) => (k -> RingMap a k -> Maybe a) -> k -> i @@ -195,7 +196,7 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $ where -- for some reason, just reusing the already-bound @rmap@ and @getterFunc@ -- variables leads to a type error, these need to be passed explicitly - takeEntriesUntil :: (HasKeyID a, Integral i, Bounded k, Ord k) + takeEntriesUntil :: (HasKeyID a k, Integral i, Bounded k, Ord k) => RingMap a k -> (k -> RingMap a k -> Maybe a) -- getter function -> k @@ -209,14 +210,14 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $ | otherwise = let (Just gotEntry) = getterFunc' previousEntry rmap' in takeEntriesUntil rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) -takeRMapPredecessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) +takeRMapPredecessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k) => k -> i -> RingMap a k -> [a] takeRMapPredecessors = takeRMapEntries_ rMapLookupPred -takeRMapSuccessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) +takeRMapSuccessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k) => k -> i -> RingMap a k -- 2.42.0