Compare commits

...

3 commits

2 changed files with 14 additions and 12 deletions

View file

@ -60,6 +60,7 @@ import Hash2Pub.FediChordTypes (CacheEntry (..),
NodeID, NodeState (..), NodeID, NodeState (..),
RemoteNodeState (..), RemoteNodeState (..),
RingEntry (..), RingMap (..), RingEntry (..), RingMap (..),
addRMapEntryWith,
cacheGetNodeStateUnvalidated, cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred, cacheLookup, cacheLookupPred,
cacheLookupSucc, localCompare, cacheLookupSucc, localCompare,
@ -114,14 +115,14 @@ addCacheEntry entry cache = do
-- | pure version of 'addCacheEntry' with current time explicitly specified as argument -- | pure version of 'addCacheEntry' with current time explicitly specified as argument
addCacheEntryPure :: POSIXTime -- ^ current time addCacheEntryPure :: POSIXTime -- ^ current time
-> RemoteCacheEntry -- ^ a remote cache entry received from network -> RemoteCacheEntry -- ^ a remote cache entry received from network
-> NodeCache -- ^ node cache to insert to -> NodeCache -- ^ node cache to insert to
-> NodeCache -- ^ new node cache with the element inserted -> NodeCache -- ^ new node cache with the element inserted
addCacheEntryPure now (RemoteCacheEntry ns ts) cache = 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 = addRMapEntryWith insertCombineFunction (KeyEntry (CacheEntry False ns timestamp')) cache newCache = addRMapEntryWith insertCombineFunction (CacheEntry False ns timestamp') cache
insertCombineFunction newVal@(KeyEntry (CacheEntry 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)

View file

@ -149,9 +149,9 @@ data LocalNodeState = LocalNodeState
-- ^ EpiChord node cache with expiry times for nodes -- ^ EpiChord node cache with expiry times for nodes
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache) , cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
-- ^ cache updates are not written directly to the 'nodeCache' but queued and -- ^ cache updates are not written directly to the 'nodeCache' but queued and
, successors :: RingMap RemoteNodeState -- could be a set instead as these are ordered as well , successors :: [RemoteNodeState] -- could be a set instead as these are ordered as well
-- ^ successor nodes in ascending order by distance -- ^ successor nodes in ascending order by distance
, predecessors :: RingMap RemoteNodeState , predecessors :: [RemoteNodeState]
-- ^ predecessor nodes in ascending order by distance -- ^ predecessor nodes in ascending order by distance
, kNeighbours :: Int , kNeighbours :: Int
-- ^ desired length of predecessor and successor list -- ^ desired length of predecessor and successor list
@ -231,13 +231,14 @@ instance Typeable a => Show (TVar a) where
instance Typeable a => Show (TQueue a) where instance Typeable a => Show (TQueue a) where
show x = show (typeOf x) show x = show (typeOf x)
-- | convenience function that updates the successors of a 'LocalNodeState' -- | convenience function that updates the successors of a 'LocalNodeState'
setSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState setSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
setSuccessors succ' ns = ns {successors = take (kNeighbours ns) . nub . sortBy (localCompare `on` getNid) . filter ((== LT) . (localCompare `on` getNid) (toRemoteNodeState ns)) $ succ'} setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList $ succs}
-- | convenience function that updates the predecessors of a 'LocalNodeState' -- | convenience function that updates the predecessors of a 'LocalNodeState'
setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
setPredecessors pred' ns = ns {predecessors = take (kNeighbours ns) . nub . sortBy (flip localCompare `on` getNid) . filter ((== GT) . (localCompare `on` getNid) (toRemoteNodeState ns)) $ pred'} setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList $ preds}
-- | Class for all types that can be identified via an EpiChord key. -- | Class for all types that can be identified via an EpiChord key.
-- Used for restricting the types a 'RingMap' can store -- Used for restricting the types a 'RingMap' can store
@ -255,10 +256,10 @@ type NodeCache = RingMap CacheEntry
-- | generic data structure for holding elements with a key and modular lookup -- | generic data structure for holding elements with a key and modular lookup
newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
instance Eq (RingMap a) where instance (HasKeyID a) => Eq (RingMap a) where
a == b = getRingMap a == getRingMap b a == b = getRingMap a == getRingMap b
instance Show (RingMap a) where instance (HasKeyID a) => Show (RingMap a) where
show rmap = shows (getRingMap rmap) "RingMap " show rmap = shows (getRingMap rmap) "RingMap "
-- | entry of a 'RingMap' that holds a value and can also -- | entry of a 'RingMap' that holds a value and can also
@ -463,8 +464,8 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $
takeEntriesUntil havingReached previousEntry remaining takeAcc takeEntriesUntil havingReached previousEntry remaining takeAcc
| remaining <= 0 = takeAcc | remaining <= 0 = takeAcc
| getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
| otherwise = let (Just gotEntry) = getterFunc (getKeyID previousEntry) rmap | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap
in takeEntriesUntil (getKeyID havingReached) (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
takeRMapPredecessors :: (HasKeyID a, Integral i) takeRMapPredecessors :: (HasKeyID a, Integral i)
=> NodeID => NodeID