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, cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred, cacheLookup, cacheLookupPred,
cacheLookupSucc, getKeyID, cacheLookupSucc, getKeyID,
localCompare, localCompare, localCompare, rMapFromList,
rMapFromList, rMapLookupPred, rMapLookupPred, rMapLookupSucc,
rMapLookupSucc,
setPredecessors, setSuccessors) setPredecessors, setSuccessors)
import Hash2Pub.ProtocolTypes import Hash2Pub.ProtocolTypes

View file

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

View file

@ -26,6 +26,8 @@ module Hash2Pub.FediChordTypes (
, rMapLookupSucc , rMapLookupSucc
, addRMapEntry , addRMapEntry
, addRMapEntryWith , addRMapEntryWith
, addPredecessors
, addSuccessors
, takeRMapPredecessors , takeRMapPredecessors
, takeRMapSuccessors , takeRMapSuccessors
, deleteRMapEntry , deleteRMapEntry
@ -238,13 +240,21 @@ 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 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 :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList $ succs} setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList $ succs}
-- | convenience function that updates the predecessors of a 'LocalNodeState' -- | sets the predecessors of a 'LocalNodeState' to the closest k nodes of the current predecessors and the provided list, combined
setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState addPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList $ preds} 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. -- | 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