From 061bce2b08370feff699893526ec146ecaa6f26b Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Mon, 15 Jun 2020 15:14:00 +0200 Subject: [PATCH 1/2] 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 From 22a6becf6bcac9601c0561b60d39c240bbf1c2b1 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Mon, 15 Jun 2020 16:41:03 +0200 Subject: [PATCH 2/2] fix all previously working tests --- src/Hash2Pub/FediChordTypes.hs | 23 ++++++++++++++++++----- test/FediChordSpec.hs | 15 ++++++++------- 2 files changed, 26 insertions(+), 12 deletions(-) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index c09c02b..bd5db0e 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -18,6 +18,7 @@ module Hash2Pub.FediChordTypes ( , CacheEntry(..) , RingEntry(..) , RingMap(..) + , rMapSize , cacheGetNodeStateUnvalidated , initCache , cacheEntries @@ -39,7 +40,8 @@ import Control.Exception import Data.Function (on) import Data.List (delete, nub, sortBy) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Maybe (fromMaybe, isJust, isNothing, + mapMaybe) import qualified Data.Set as Set import Data.Time.Clock.POSIX import Network.Socket @@ -253,6 +255,7 @@ data RingEntry a = KeyEntry a -- | 'RingEntry' type for usage as a node cache data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime + deriving (Show, Eq) -- | as a compromise, only KeyEntry components are ordered by their NodeID @@ -308,6 +311,18 @@ cacheLookup :: NodeID -- ^lookup key -> Maybe CacheEntry 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 @@ -371,10 +386,8 @@ cacheLookupPred = rMapLookupPred -- transfer difference now - entry to other node -- | return the @NodeState@ data from a cache entry without checking its validation status -cacheGetNodeStateUnvalidated :: RingEntry CacheEntry -> RemoteNodeState -cacheGetNodeStateUnvalidated (KeyEntry (CacheEntry _ nState _)) = nState -cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry -cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug" +cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState +cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString ipAddrAsBS :: HostAddress6 -> BS.ByteString diff --git a/test/FediChordSpec.hs b/test/FediChordSpec.hs index ab9f1b2..0ac0ea9 100644 --- a/test/FediChordSpec.hs +++ b/test/FediChordSpec.hs @@ -2,11 +2,11 @@ module FediChordSpec where import Control.Exception -import Data.ASN1.Parse (runParseASN1) -import qualified Data.ByteString as BS -import qualified Data.Map.Strict as Map -import Data.Maybe (fromJust, isJust) -import qualified Data.Set as Set +import Data.ASN1.Parse (runParseASN1) +import qualified Data.ByteString as BS +import qualified Data.Map.Strict as Map +import Data.Maybe (fromJust, isJust) +import qualified Data.Set as Set import Data.Time.Clock.POSIX import Network.Socket import Test.Hspec @@ -14,6 +14,7 @@ import Test.Hspec import Hash2Pub.ASN1Coding import Hash2Pub.DHTProtocol import Hash2Pub.FediChord +import Hash2Pub.FediChordTypes spec :: Spec spec = do @@ -79,8 +80,8 @@ spec = do newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache) exampleID = nid exampleNodeState it "entries can be added to a node cache and looked up again" $ do - -- the cache includes 2 additional proxy elements right from the start - Map.size newCache - Map.size emptyCache `shouldBe` 2 + rMapSize emptyCache `shouldBe` 0 + rMapSize newCache `shouldBe` 2 -- normal entry lookup nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing