From 061bce2b08370feff699893526ec146ecaa6f26b Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Mon, 15 Jun 2020 15:14:00 +0200 Subject: [PATCH] adjust types to refactored RingMap NodeCache --- src/Hash2Pub/DHTProtocol.hs | 23 +++++++++++++---------- src/Hash2Pub/FediChordTypes.hs | 3 +++ src/Hash2Pub/ProtocolTypes.hs | 9 +++------ 3 files changed, 19 insertions(+), 16 deletions(-) diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 6469e1c..48f1a19 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -54,10 +54,12 @@ import System.Timeout import Hash2Pub.ASN1Coding import Hash2Pub.FediChordTypes (CacheEntry (..), + CacheEntry (..), LocalNodeState (..), LocalNodeStateSTM, NodeCache, NodeID, NodeState (..), RemoteNodeState (..), + RingEntry (..), RingMap (..), cacheGetNodeStateUnvalidated, cacheLookup, cacheLookupPred, cacheLookupSucc, localCompare, @@ -83,7 +85,7 @@ queryLocalCache ownState nCache lBestNodes targetID preds = predecessors ownState 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 = closestPredecessor (lBestNodes-1) $ getNid ownState @@ -94,10 +96,11 @@ queryLocalCache ownState nCache lBestNodes targetID | otherwise = let result = cacheLookupPred lastID nCache in - case toRemoteCacheEntry =<< result of + case toRemoteCacheEntry <$> result of Nothing -> Set.empty Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns) + -- cache operations -- | update or insert a 'RemoteCacheEntry' into the cache, @@ -118,22 +121,22 @@ addCacheEntryPure now (RemoteCacheEntry ns ts) cache = let -- 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 - newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache - insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = + newCache = Map.insertWith insertCombineFunction (nid ns) (KeyEntry (CacheEntry False ns timestamp')) $ getRingMap cache + insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal = case oldVal of 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 - newCache + RingMap newCache -- | delete the node with given ID from cache deleteCacheEntry :: NodeID -- ^ID of the node to be deleted -> NodeCache -- ^cache to delete from -> NodeCache -- ^cache without the specified element -deleteCacheEntry = Map.update modifier +deleteCacheEntry nid = RingMap . Map.update modifier nid . getRingMap where 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. markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to be @@ -141,9 +144,9 @@ markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to -> NodeID -- ^ which node to mark -> NodeCache -- ^ current node cache -> NodeCache -- ^ new NodeCache with the updated entry -markCacheEntryAsVerified timestamp = Map.adjust adjustFunc +markCacheEntryAsVerified timestamp nid = RingMap . Map.adjust adjustFunc nid . getRingMap 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 entry = entry diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index f887095..c09c02b 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -16,8 +16,11 @@ module Hash2Pub.FediChordTypes ( , setPredecessors , NodeCache , CacheEntry(..) + , RingEntry(..) + , RingMap(..) , cacheGetNodeStateUnvalidated , initCache + , cacheEntries , cacheLookup , cacheLookupSucc , cacheLookupPred diff --git a/src/Hash2Pub/ProtocolTypes.hs b/src/Hash2Pub/ProtocolTypes.hs index afb72d2..15cb863 100644 --- a/src/Hash2Pub/ProtocolTypes.hs +++ b/src/Hash2Pub/ProtocolTypes.hs @@ -89,15 +89,12 @@ data RemoteCacheEntry = RemoteCacheEntry RemoteNodeState POSIXTime instance Ord RemoteCacheEntry where (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 -> Maybe RemoteCacheEntry -toRemoteCacheEntry (NodeEntry _ ns ts) = Just $ RemoteCacheEntry ns ts -toRemoteCacheEntry (ProxyEntry _ (Just entry@NodeEntry{})) = toRemoteCacheEntry entry -toRemoteCacheEntry _ = Nothing +toRemoteCacheEntry :: CacheEntry -> RemoteCacheEntry +toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts -- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers toRemoteCache :: NodeCache -> [RemoteCacheEntry] -toRemoteCache cache = mapMaybe toRemoteCacheEntry $ Map.elems cache +toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache -- | extract the 'NodeState' from a 'RemoteCacheEntry' remoteNode :: RemoteCacheEntry -> RemoteNodeState