diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 6838137..68b6b9d 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -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 diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index 6a66220..7a184f4 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -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 diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index 601ca63..363e300 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -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