adjust types to refactored RingMap NodeCache

This commit is contained in:
Trolli Schmittlauch 2020-06-15 15:14:00 +02:00
parent 6a98b5c6da
commit 061bce2b08
3 changed files with 19 additions and 16 deletions

View file

@ -54,10 +54,12 @@ import System.Timeout
import Hash2Pub.ASN1Coding import Hash2Pub.ASN1Coding
import Hash2Pub.FediChordTypes (CacheEntry (..), import Hash2Pub.FediChordTypes (CacheEntry (..),
CacheEntry (..),
LocalNodeState (..), LocalNodeState (..),
LocalNodeStateSTM, NodeCache, LocalNodeStateSTM, NodeCache,
NodeID, NodeState (..), NodeID, NodeState (..),
RemoteNodeState (..), RemoteNodeState (..),
RingEntry (..), RingMap (..),
cacheGetNodeStateUnvalidated, cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred, cacheLookup, cacheLookupPred,
cacheLookupSucc, localCompare, cacheLookupSucc, localCompare,
@ -83,7 +85,7 @@ queryLocalCache ownState nCache lBestNodes targetID
preds = predecessors ownState preds = predecessors ownState
closestSuccessor :: Set.Set RemoteCacheEntry closestSuccessor :: Set.Set RemoteCacheEntry
closestSuccessor = maybe Set.empty Set.singleton $ toRemoteCacheEntry =<< cacheLookupSucc targetID nCache closestSuccessor = maybe Set.empty (Set.singleton . toRemoteCacheEntry) $ cacheLookupSucc targetID nCache
closestPredecessors :: Set.Set RemoteCacheEntry closestPredecessors :: Set.Set RemoteCacheEntry
closestPredecessors = closestPredecessor (lBestNodes-1) $ getNid ownState closestPredecessors = closestPredecessor (lBestNodes-1) $ getNid ownState
@ -94,10 +96,11 @@ queryLocalCache ownState nCache lBestNodes targetID
| otherwise = | otherwise =
let result = cacheLookupPred lastID nCache let result = cacheLookupPred lastID nCache
in in
case toRemoteCacheEntry =<< result of case toRemoteCacheEntry <$> result of
Nothing -> Set.empty Nothing -> Set.empty
Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns) Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns)
-- cache operations -- cache operations
-- | update or insert a 'RemoteCacheEntry' into the cache, -- | update or insert a 'RemoteCacheEntry' into the cache,
@ -118,22 +121,22 @@ addCacheEntryPure now (RemoteCacheEntry ns ts) cache =
let let
-- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity
timestamp' = if ts <= now then ts else now timestamp' = if ts <= now then ts else now
newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache newCache = Map.insertWith insertCombineFunction (nid ns) (KeyEntry (CacheEntry False ns timestamp')) $ getRingMap cache
insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal =
case oldVal of case oldVal of
ProxyEntry n _ -> ProxyEntry n (Just newVal) ProxyEntry n _ -> ProxyEntry n (Just newVal)
NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp) KeyEntry (CacheEntry oldValidationState _ oldTimestamp) -> KeyEntry (CacheEntry oldValidationState newNode (max oldTimestamp newTimestamp))
in in
newCache RingMap newCache
-- | delete the node with given ID from cache -- | delete the node with given ID from cache
deleteCacheEntry :: NodeID -- ^ID of the node to be deleted deleteCacheEntry :: NodeID -- ^ID of the node to be deleted
-> NodeCache -- ^cache to delete from -> NodeCache -- ^cache to delete from
-> NodeCache -- ^cache without the specified element -> NodeCache -- ^cache without the specified element
deleteCacheEntry = Map.update modifier deleteCacheEntry nid = RingMap . Map.update modifier nid . getRingMap
where where
modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
modifier NodeEntry {} = Nothing modifier KeyEntry {} = Nothing
-- | Mark a cache entry as verified after pinging it, possibly bumping its timestamp. -- | Mark a cache entry as verified after pinging it, possibly bumping its timestamp.
markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to be markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to be
@ -141,9 +144,9 @@ markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to
-> NodeID -- ^ which node to mark -> NodeID -- ^ which node to mark
-> NodeCache -- ^ current node cache -> NodeCache -- ^ current node cache
-> NodeCache -- ^ new NodeCache with the updated entry -> NodeCache -- ^ new NodeCache with the updated entry
markCacheEntryAsVerified timestamp = Map.adjust adjustFunc markCacheEntryAsVerified timestamp nid = RingMap . Map.adjust adjustFunc nid . getRingMap
where where
adjustFunc (NodeEntry _ ns ts) = NodeEntry True ns $ fromMaybe ts timestamp adjustFunc (KeyEntry (CacheEntry _ ns ts)) = KeyEntry (CacheEntry True ns $ fromMaybe ts timestamp)
adjustFunc (ProxyEntry _ (Just entry)) = adjustFunc entry adjustFunc (ProxyEntry _ (Just entry)) = adjustFunc entry
adjustFunc entry = entry adjustFunc entry = entry

View file

@ -16,8 +16,11 @@ module Hash2Pub.FediChordTypes (
, setPredecessors , setPredecessors
, NodeCache , NodeCache
, CacheEntry(..) , CacheEntry(..)
, RingEntry(..)
, RingMap(..)
, cacheGetNodeStateUnvalidated , cacheGetNodeStateUnvalidated
, initCache , initCache
, cacheEntries
, cacheLookup , cacheLookup
, cacheLookupSucc , cacheLookupSucc
, cacheLookupPred , cacheLookupPred

View file

@ -89,15 +89,12 @@ data RemoteCacheEntry = RemoteCacheEntry RemoteNodeState POSIXTime
instance Ord RemoteCacheEntry where instance Ord RemoteCacheEntry where
(RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2 (RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2
-- | Extracts a 'RemoteCacheEntry' from the indirections of a 'CacheEntry', if it holds one toRemoteCacheEntry :: CacheEntry -> RemoteCacheEntry
toRemoteCacheEntry :: CacheEntry -> Maybe RemoteCacheEntry toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts
toRemoteCacheEntry (NodeEntry _ ns ts) = Just $ RemoteCacheEntry ns ts
toRemoteCacheEntry (ProxyEntry _ (Just entry@NodeEntry{})) = toRemoteCacheEntry entry
toRemoteCacheEntry _ = Nothing
-- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers -- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers
toRemoteCache :: NodeCache -> [RemoteCacheEntry] toRemoteCache :: NodeCache -> [RemoteCacheEntry]
toRemoteCache cache = mapMaybe toRemoteCacheEntry $ Map.elems cache toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache
-- | extract the 'NodeState' from a 'RemoteCacheEntry' -- | extract the 'NodeState' from a 'RemoteCacheEntry'
remoteNode :: RemoteCacheEntry -> RemoteNodeState remoteNode :: RemoteCacheEntry -> RemoteNodeState