diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 48f1a19..6469e1c 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -54,12 +54,10 @@ import System.Timeout import Hash2Pub.ASN1Coding import Hash2Pub.FediChordTypes (CacheEntry (..), - CacheEntry (..), LocalNodeState (..), LocalNodeStateSTM, NodeCache, NodeID, NodeState (..), RemoteNodeState (..), - RingEntry (..), RingMap (..), cacheGetNodeStateUnvalidated, cacheLookup, cacheLookupPred, cacheLookupSucc, localCompare, @@ -85,7 +83,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 @@ -96,11 +94,10 @@ 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, @@ -121,22 +118,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) (KeyEntry (CacheEntry False ns timestamp')) $ getRingMap cache - insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal = + newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache + insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = case oldVal of ProxyEntry n _ -> ProxyEntry n (Just newVal) - KeyEntry (CacheEntry oldValidationState _ oldTimestamp) -> KeyEntry (CacheEntry oldValidationState newNode (max oldTimestamp newTimestamp)) + NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp) in - RingMap newCache + 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 nid = RingMap . Map.update modifier nid . getRingMap +deleteCacheEntry = Map.update modifier where modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) - modifier KeyEntry {} = Nothing + modifier NodeEntry {} = Nothing -- | Mark a cache entry as verified after pinging it, possibly bumping its timestamp. markCacheEntryAsVerified :: Maybe POSIXTime -- ^ the (current) timestamp to be @@ -144,9 +141,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 nid = RingMap . Map.adjust adjustFunc nid . getRingMap +markCacheEntryAsVerified timestamp = Map.adjust adjustFunc where - adjustFunc (KeyEntry (CacheEntry _ ns ts)) = KeyEntry (CacheEntry True ns $ fromMaybe ts timestamp) + adjustFunc (NodeEntry _ ns ts) = NodeEntry 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 bd5db0e..f887095 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -16,12 +16,8 @@ module Hash2Pub.FediChordTypes ( , setPredecessors , NodeCache , CacheEntry(..) - , RingEntry(..) - , RingMap(..) - , rMapSize , cacheGetNodeStateUnvalidated , initCache - , cacheEntries , cacheLookup , cacheLookupSucc , cacheLookupPred @@ -40,8 +36,7 @@ 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, isNothing, - mapMaybe) +import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Set as Set import Data.Time.Clock.POSIX import Network.Socket @@ -255,7 +250,6 @@ 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 @@ -311,18 +305,6 @@ 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 @@ -386,8 +368,10 @@ cacheLookupPred = rMapLookupPred -- transfer difference now - entry to other node -- | return the @NodeState@ data from a cache entry without checking its validation status -cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState -cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState +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" -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString ipAddrAsBS :: HostAddress6 -> BS.ByteString diff --git a/src/Hash2Pub/ProtocolTypes.hs b/src/Hash2Pub/ProtocolTypes.hs index 15cb863..afb72d2 100644 --- a/src/Hash2Pub/ProtocolTypes.hs +++ b/src/Hash2Pub/ProtocolTypes.hs @@ -89,12 +89,15 @@ data RemoteCacheEntry = RemoteCacheEntry RemoteNodeState POSIXTime instance Ord RemoteCacheEntry where (RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2 -toRemoteCacheEntry :: CacheEntry -> RemoteCacheEntry -toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts +-- | 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 -- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers toRemoteCache :: NodeCache -> [RemoteCacheEntry] -toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache +toRemoteCache cache = mapMaybe toRemoteCacheEntry $ Map.elems cache -- | extract the 'NodeState' from a 'RemoteCacheEntry' remoteNode :: RemoteCacheEntry -> RemoteNodeState diff --git a/test/FediChordSpec.hs b/test/FediChordSpec.hs index 0ac0ea9..ab9f1b2 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,7 +14,6 @@ import Test.Hspec import Hash2Pub.ASN1Coding import Hash2Pub.DHTProtocol import Hash2Pub.FediChord -import Hash2Pub.FediChordTypes spec :: Spec spec = do @@ -80,8 +79,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 - rMapSize emptyCache `shouldBe` 0 - rMapSize newCache `shouldBe` 2 + -- the cache includes 2 additional proxy elements right from the start + Map.size newCache - Map.size emptyCache `shouldBe` 2 -- normal entry lookup nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing