Compare commits

...

2 commits

4 changed files with 45 additions and 28 deletions

View file

@ -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

View file

@ -16,8 +16,12 @@ module Hash2Pub.FediChordTypes (
, setPredecessors , setPredecessors
, NodeCache , NodeCache
, CacheEntry(..) , CacheEntry(..)
, RingEntry(..)
, RingMap(..)
, rMapSize
, cacheGetNodeStateUnvalidated , cacheGetNodeStateUnvalidated
, initCache , initCache
, cacheEntries
, cacheLookup , cacheLookup
, cacheLookupSucc , cacheLookupSucc
, cacheLookupPred , cacheLookupPred
@ -36,7 +40,8 @@ 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, mapMaybe) import Data.Maybe (fromMaybe, isJust, isNothing,
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
@ -250,6 +255,7 @@ 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
@ -305,6 +311,18 @@ 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
@ -368,10 +386,8 @@ 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 :: RingEntry CacheEntry -> RemoteNodeState cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState
cacheGetNodeStateUnvalidated (KeyEntry (CacheEntry _ nState _)) = nState cacheGetNodeStateUnvalidated (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,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

View file

@ -14,6 +14,7 @@ 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
@ -79,8 +80,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
-- the cache includes 2 additional proxy elements right from the start rMapSize emptyCache `shouldBe` 0
Map.size newCache - Map.size emptyCache `shouldBe` 2 rMapSize newCache `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