schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

re-structure convergenceSampleThread to work on a RealNode and iterate over all joined vservers

Browse source 
contributes to #34
This commit is contained in:
Trolli Schmittlauch 2020-09-21 02:18:28 +02:00
parent 33ae904d17
commit 8e8ea41dc4
1 changed files with 32 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
src/Hash2Pub/FediChord.hs
View file

@ -133,7 +133,7 @@ fediChordInit initConf serviceRunner = do
putStrLn $ err <> " Error joining, start listening for incoming requests anyways"
-- launch thread attempting to join on new cache entries
_ <- forkIO $ joinOnNewEntriesThread firstVSSTM
async (fediMainThreads serverSock firstVSSTM)
async (fediMainThreads serverSock realNodeSTM)
)
(\joinedNS -> do
-- launch main eventloop with successfully joined state
@ -195,33 +195,36 @@ fediChordBootstrapJoin nsSTM bootstrapNode = do
-- Periodically lookup own ID through a random bootstrapping node to discover and merge separated DHT clusters.
-- Unjoined try joining instead.
convergenceSampleThread :: Service s (RealNodeSTM s) => LocalNodeStateSTM s -> IO ()
convergenceSampleThread nsSTM = forever $ do
nsSnap <- readTVarIO nsSTM
parentNode <- readTVarIO $ parentRealNode nsSnap
if isJoined nsSnap
then
runExceptT (do
-- joined node: choose random node, do queryIDLoop, compare result with own responsibility
let bss = bootstrapNodes parentNode
randIndex <- liftIO $ randomRIO (0, length bss - 1)
chosenNode <- maybe (throwError "invalid bootstrapping node index") pure $ atMay bss randIndex
lookupResult <- liftIO $ bootstrapQueryId nsSTM chosenNode (getNid nsSnap)
currentlyResponsible <- liftEither lookupResult
if getNid currentlyResponsible /= getNid nsSnap
-- if mismatch, stabilise on the result, else do nothing
then do
stabResult <- liftIO $ requestStabilise nsSnap currentlyResponsible
(preds, succs) <- liftEither stabResult
-- TODO: verify neighbours before adding, see #55
liftIO . atomically $ do
ns <- readTVar nsSTM
writeTVar nsSTM $ addPredecessors preds ns
else pure ()
) >> pure ()
-- unjoined node: try joining through all bootstrapping nodes
else tryBootstrapJoining nsSTM >> pure ()
let delaySecs = confBootstrapSamplingInterval . nodeConfig $ parentNode
convergenceSampleThread :: Service s (RealNodeSTM s) => RealNodeSTM s -> IO ()
convergenceSampleThread nodeSTM = forever $ do
node <- readTVarIO nodeSTM
forM_ (vservers node) $ \nsSTM -> do
nsSnap <- readTVarIO nsSTM
parentNode <- readTVarIO $ parentRealNode nsSnap
if isJoined nsSnap
then
runExceptT (do
-- joined node: choose random node, do queryIDLoop, compare result with own responsibility
let bss = bootstrapNodes parentNode
randIndex <- liftIO $ randomRIO (0, length bss - 1)
chosenNode <- maybe (throwError "invalid bootstrapping node index") pure $ atMay bss randIndex
lookupResult <- liftIO $ bootstrapQueryId nsSTM chosenNode (getNid nsSnap)
currentlyResponsible <- liftEither lookupResult
if getNid currentlyResponsible /= getNid nsSnap
-- if mismatch, stabilise on the result, else do nothing
then do
stabResult <- liftIO $ requestStabilise nsSnap currentlyResponsible
(preds, succs) <- liftEither stabResult
-- TODO: verify neighbours before adding, see #55
liftIO . atomically $ do
ns <- readTVar nsSTM
writeTVar nsSTM $ addPredecessors preds ns
else pure ()
) >> pure ()
-- unjoined node: try joining through all bootstrapping nodes
else tryBootstrapJoining nsSTM >> pure ()
let delaySecs = confBootstrapSamplingInterval . nodeConfig $ node
threadDelay delaySecs
@ -657,7 +660,7 @@ fediMainThreads sock nodeSTM = do
-- choose option 2 for the sake of limiting concurrency in simulation scenario
concurrently_ (stabiliseThread nodeSTM) $
concurrently_ (nodeCacheVerifyThread nodeSTM) $
concurrently_ (convergenceSampleThread nsSTM) $
concurrently_ (convergenceSampleThread nodeSTM) $
concurrently_ (lookupCacheCleanup $ parentRealNode ns) $
concurrently_
(sendThread sock sendQ)