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 (..),
RemoteNodeState (..),
RingEntry (..), RingMap (..),
addRMapEntryWith,
cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred,
cacheLookupSucc, localCompare,
@ -114,14 +115,14 @@ addCacheEntry entry cache = do
-- | pure version of 'addCacheEntry' with current time explicitly specified as argument
addCacheEntryPure :: POSIXTime -- ^ current time
-> RemoteCacheEntry -- ^ a remote cache entry received from network
-> NodeCache -- ^ node cache to insert to
-> NodeCache -- ^ new node cache with the element inserted
-> RemoteCacheEntry -- ^ a remote cache entry received from network
-> NodeCache -- ^ node cache to insert to
-> NodeCache -- ^ new node cache with the element inserted
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 = addRMapEntryWith insertCombineFunction (KeyEntry (CacheEntry False ns timestamp')) cache
newCache = addRMapEntryWith insertCombineFunction (CacheEntry False ns timestamp') cache
insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal =
case oldVal of
ProxyEntry n _ -> ProxyEntry n (Just newVal)

View file

@ -149,9 +149,9 @@ data LocalNodeState = LocalNodeState
-- ^ EpiChord node cache with expiry times for nodes
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
-- ^ 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
, predecessors :: RingMap RemoteNodeState
, predecessors :: [RemoteNodeState]
-- ^ predecessor nodes in ascending order by distance
, kNeighbours :: Int
-- ^ 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
show x = show (typeOf x)
-- | convenience function that updates the successors of a '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'
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.
-- 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
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
instance Show (RingMap a) where
instance (HasKeyID a) => Show (RingMap a) where
show rmap = shows (getRingMap rmap) "RingMap "
-- | 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
| remaining <= 0 = takeAcc
| getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
| otherwise = let (Just gotEntry) = getterFunc (getKeyID previousEntry) rmap
in takeEntriesUntil (getKeyID havingReached) (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
| otherwise = let (Just gotEntry) = getterFunc previousEntry rmap
in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
takeRMapPredecessors :: (HasKeyID a, Integral i)
=> NodeID