diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 2fe41eb..3c6cd6c 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -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) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index b41e3dd..27d5f32 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -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