forked from schmittlauch/Hash2Pub
adjust types to refactored RingMap NodeCache
This commit is contained in:
parent
6a98b5c6da
commit
061bce2b08
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue