Compare commits
3 commits
2269357ed0
...
43e4ab184e
Author | SHA1 | Date | |
---|---|---|---|
|
43e4ab184e | ||
|
fb164dea0a | ||
|
7e08250f8c |
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue