refactor adding neighbours

This commit is contained in:
Trolli Schmittlauch 2020-06-19 19:14:25 +02:00
parent e898b80762
commit 00ff2bf071
3 changed files with 22 additions and 14 deletions

View file

@ -64,9 +64,8 @@ import Hash2Pub.FediChordTypes (CacheEntry (..),
cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred,
cacheLookupSucc, getKeyID,
localCompare, localCompare,
rMapFromList, rMapLookupPred,
rMapLookupSucc,
localCompare, rMapFromList,
rMapLookupPred, rMapLookupSucc,
setPredecessors, setSuccessors)
import Hash2Pub.ProtocolTypes

View file

@ -184,15 +184,14 @@ stabiliseThread :: LocalNodeStateSTM -> IO ()
stabiliseThread nsSTM = do
-- TODO: update successfully stabilised nodes in cache
-- placeholder
stabiliseNeighbour nsSTM successors setSuccessors 1
stabiliseNeighbour nsSTM successors 1
pure ()
where
stabiliseNeighbour :: LocalNodeStateSTM
-> (LocalNodeState -> [RemoteNodeState])
-> ([RemoteNodeState] -> LocalNodeState -> LocalNodeState)
-> Int
-> IO (Either String ())
stabiliseNeighbour nsSTM neighbourGetter neighbourSetter neighbourNum = do
stabiliseNeighbour nsSTM neighbourGetter neighbourNum = do
nsSnap <- readTVarIO nsSTM
let chosenNode = maybe (Left "no such neighbour entry") Right $ atMay (neighbourGetter nsSnap) neighbourNum
-- returning @Left@ signifies the need to try again with next from list
@ -210,7 +209,7 @@ stabiliseThread nsSTM = do
parseNeighbourResponse (Right (succs, preds)) = liftIO $ do
atomically $ do
newerNsSnap <- readTVar nsSTM
writeTVar nsSTM $ setPredecessors (predecessors newerNsSnap <> preds) . setSuccessors (successors newerNsSnap <> succs) $ newerNsSnap
writeTVar nsSTM $ addPredecessors preds . addSuccessors succs $ newerNsSnap
pure ()
-- periodically contact immediate successor and predecessor

View file

@ -19,19 +19,21 @@ module Hash2Pub.FediChordTypes (
, RingEntry(..)
, RingMap(..)
, HasKeyID
, getKeyID
, getKeyID
, rMapSize
, rMapLookup
, rMapLookupPred
, rMapLookupSucc
, addRMapEntry
, addRMapEntryWith
, addPredecessors
, addSuccessors
, takeRMapPredecessors
, takeRMapSuccessors
, deleteRMapEntry
, setRMapEntries
, rMapFromList
, rMapToList
, rMapFromList
, rMapToList
, cacheGetNodeStateUnvalidated
, initCache
, cacheEntries
@ -238,13 +240,21 @@ instance Typeable a => Show (TQueue a) where
show x = show (typeOf x)
-- | convenience function that updates the successors of a 'LocalNodeState'
-- | convenience function that replaces the predecessors of a 'LocalNodeState' with the k closest nodes from the provided list
setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList $ preds}
-- | convenience function that replaces the successors of a 'LocalNodeState' with the k closest nodes from the provided list
setSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
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 preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList $ preds}
-- | sets the predecessors of a 'LocalNodeState' to the closest k nodes of the current predecessors and the provided list, combined
addPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . addRMapEntries preds . rMapFromList $ predecessors ns}
-- | sets the successors of a 'LocalNodeState' to the closest k nodes of the current successors and the provided list, combined
addSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries succs . rMapFromList $ successors ns}
-- | Class for all types that can be identified via an EpiChord key.
-- Used for restricting the types a 'RingMap' can store