Compare commits

..

No commits in common. "22a6becf6bcac9601c0561b60d39c240bbf1c2b1" and "6a98b5c6daa2284c65acd6fb00f9e9d550afaefe" have entirely different histories.

4 changed files with 28 additions and 45 deletions

View file

@ -54,12 +54,10 @@ 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,
@ -85,7 +83,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
@ -96,11 +94,10 @@ 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,
@ -121,22 +118,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) (KeyEntry (CacheEntry False ns timestamp')) $ getRingMap cache newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache
insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal = insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal =
case oldVal of case oldVal of
ProxyEntry n _ -> ProxyEntry n (Just newVal) 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 in
RingMap newCache 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 nid = RingMap . Map.update modifier nid . getRingMap deleteCacheEntry = Map.update modifier
where where
modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) 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. -- | 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
@ -144,9 +141,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 nid = RingMap . Map.adjust adjustFunc nid . getRingMap markCacheEntryAsVerified timestamp = Map.adjust adjustFunc
where 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 (ProxyEntry _ (Just entry)) = adjustFunc entry
adjustFunc entry = entry adjustFunc entry = entry

View file

@ -16,12 +16,8 @@ module Hash2Pub.FediChordTypes (
, setPredecessors , setPredecessors
, NodeCache , NodeCache
, CacheEntry(..) , CacheEntry(..)
, RingEntry(..)
, RingMap(..)
, rMapSize
, cacheGetNodeStateUnvalidated , cacheGetNodeStateUnvalidated
, initCache , initCache
, cacheEntries
, cacheLookup , cacheLookup
, cacheLookupSucc , cacheLookupSucc
, cacheLookupPred , cacheLookupPred
@ -40,8 +36,7 @@ import Control.Exception
import Data.Function (on) import Data.Function (on)
import Data.List (delete, nub, sortBy) import Data.List (delete, nub, sortBy)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust, isNothing, import Data.Maybe (fromMaybe, isJust, mapMaybe)
mapMaybe)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Network.Socket import Network.Socket
@ -255,7 +250,6 @@ data RingEntry a = KeyEntry a
-- | 'RingEntry' type for usage as a node cache -- | 'RingEntry' type for usage as a node cache
data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime
deriving (Show, Eq)
-- | as a compromise, only KeyEntry components are ordered by their NodeID -- | as a compromise, only KeyEntry components are ordered by their NodeID
@ -311,18 +305,6 @@ cacheLookup :: NodeID -- ^lookup key
-> Maybe CacheEntry -> Maybe CacheEntry
cacheLookup = rMapLookup 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@ -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
-- to simulate a modular ring -- to simulate a modular ring
lookupWrapper :: HasKeyID a lookupWrapper :: HasKeyID a
@ -386,8 +368,10 @@ cacheLookupPred = rMapLookupPred
-- transfer difference now - entry to other node -- transfer difference now - entry to other node
-- | return the @NodeState@ data from a cache entry without checking its validation status -- | return the @NodeState@ data from a cache entry without checking its validation status
cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState cacheGetNodeStateUnvalidated :: RingEntry CacheEntry -> RemoteNodeState
cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState 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 -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
ipAddrAsBS :: HostAddress6 -> BS.ByteString ipAddrAsBS :: HostAddress6 -> BS.ByteString

View file

@ -89,12 +89,15 @@ 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
toRemoteCacheEntry :: CacheEntry -> RemoteCacheEntry -- | Extracts a 'RemoteCacheEntry' from the indirections of a 'CacheEntry', if it holds one
toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts 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 -- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers
toRemoteCache :: NodeCache -> [RemoteCacheEntry] toRemoteCache :: NodeCache -> [RemoteCacheEntry]
toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache toRemoteCache cache = mapMaybe toRemoteCacheEntry $ Map.elems cache
-- | extract the 'NodeState' from a 'RemoteCacheEntry' -- | extract the 'NodeState' from a 'RemoteCacheEntry'
remoteNode :: RemoteCacheEntry -> RemoteNodeState remoteNode :: RemoteCacheEntry -> RemoteNodeState

View file

@ -2,11 +2,11 @@
module FediChordSpec where module FediChordSpec where
import Control.Exception import Control.Exception
import Data.ASN1.Parse (runParseASN1) import Data.ASN1.Parse (runParseASN1)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Network.Socket import Network.Socket
import Test.Hspec import Test.Hspec
@ -14,7 +14,6 @@ import Test.Hspec
import Hash2Pub.ASN1Coding import Hash2Pub.ASN1Coding
import Hash2Pub.DHTProtocol import Hash2Pub.DHTProtocol
import Hash2Pub.FediChord import Hash2Pub.FediChord
import Hash2Pub.FediChordTypes
spec :: Spec spec :: Spec
spec = do spec = do
@ -80,8 +79,8 @@ spec = do
newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache) newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache)
exampleID = nid exampleNodeState exampleID = nid exampleNodeState
it "entries can be added to a node cache and looked up again" $ do it "entries can be added to a node cache and looked up again" $ do
rMapSize emptyCache `shouldBe` 0 -- the cache includes 2 additional proxy elements right from the start
rMapSize newCache `shouldBe` 2 Map.size newCache - Map.size emptyCache `shouldBe` 2
-- normal entry lookup -- normal entry lookup
nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID
nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing