From e01d84a1479843ebd7ecd36eb40d7d80cb2e7805 Mon Sep 17 00:00:00 2001 From: Klaus Aehlig Date: Thu, 28 May 2015 11:24:55 +0200 Subject: [PATCH] Provide a repeatable version of updateLocksWaiting With our timeouts on connections, we have to deal with connections being interrupted at any time. Therefore, we provide a repeatable version of updateLocksWaiting that gracefully ignores requests that have already been recorded. Signed-off-by: Klaus Aehlig Reviewed-by: Petr Pudlak --- src/Ganeti/Locking/Waiting.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/Ganeti/Locking/Waiting.hs b/src/Ganeti/Locking/Waiting.hs index bd2c6fbd9..9dec4be4c 100644 --- a/src/Ganeti/Locking/Waiting.hs +++ b/src/Ganeti/Locking/Waiting.hs @@ -38,6 +38,7 @@ module Ganeti.Locking.Waiting , emptyWaiting , updateLocks , updateLocksWaiting + , safeUpdateLocksWaiting , getAllocation , getPendingOwners , hasPendingRequest @@ -275,6 +276,7 @@ updateLocksWaiting prio owner req state = else second (second $ S.delete owner) $ updateLocksWaiting' prio owner req state + -- | Compute the state of a waiting after an owner gives up -- on his pending request. removePendingRequest :: (Lock a, Ord b, Ord c) @@ -294,6 +296,25 @@ removePendingRequest owner state = , lwPending = pending' } +-- | A repeatable version of `updateLocksWaiting`. If the owner has a pending +-- request and the pending request is equal to the current one, do nothing; +-- otherwise call updateLocksWaiting. +safeUpdateLocksWaiting :: (Lock a, Ord b, Ord c) + => c + -> b + -> [L.LockRequest a] + -> LockWaiting a b c + -> (LockWaiting a b c, (Result (S.Set b), S.Set b)) +safeUpdateLocksWaiting prio owner req state = + if hasPendingRequest owner state + && S.singleton req + == (S.map (\(_, _, r) -> r) + . S.filter (\(_, b, _) -> b == owner) $ getPendingRequests state) + then let (_, answer) = updateLocksWaiting prio owner req + $ removePendingRequest owner state + in (state, answer) + else updateLocksWaiting prio owner req state + -- | Convenience function to release all pending requests and locks -- of a given owner. Return the new configuration and the owners to -- notify. -- GitLab