From 0286f21da764bca507c1d8bc79635c448512faf1 Mon Sep 17 00:00:00 2001
From: Klaus Aehlig <aehlig@google.com>
Date: Thu, 28 May 2015 17:53:42 +0200
Subject: [PATCH] Always accept no-op requests

In order to have update requests repeatable, always
accept requests that do not require any change to the
state. Note that this is not implied by the current
definition, as the request might ask for two locks at
different level, and thus the repetition would violate
lock order.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Petr Pudlak <pudlak@google.com>
---
 src/Ganeti/Locking/Waiting.hs | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/src/Ganeti/Locking/Waiting.hs b/src/Ganeti/Locking/Waiting.hs
index c5faeb7c4..bd2c6fbd9 100644
--- a/src/Ganeti/Locking/Waiting.hs
+++ b/src/Ganeti/Locking/Waiting.hs
@@ -230,6 +230,16 @@ updateLocksWaiting' prio owner reqs state =
                                 }
   in (state'', (result, notify))
 
+-- | Predicate whether a request is already fulfilled in a given state
+-- and no requests for that owner are pending.
+requestFulfilled :: (Ord a, Ord b)
+                 => b -> [L.LockRequest a] -> LockWaiting a b c -> Bool
+requestFulfilled owner req state =
+  let locks = L.listLocks owner $ lwAllocation state
+      isFulfilled r = M.lookup (L.lockAffected r) locks
+                        == L.lockRequestType r
+  in not (hasPendingRequest owner state) && all isFulfilled req
+
 -- | Update the locks on an onwer according to the given request, if possible.
 -- Additionally (if the request succeeds) fulfill any pending requests that
 -- became possible through this request. Return the new state of the waiting
@@ -237,18 +247,22 @@ updateLocksWaiting' prio owner reqs state =
 -- The result is, as for lock allocation, the set of owners the request is
 -- blocked on. Again, the type is chosen to be suitable for use in
 -- atomicModifyIORef.
+-- For convenience, fulfilled requests are always accepted.
 updateLocks :: (Lock a, Ord b, Ord c)
             => b
             -> [L.LockRequest a]
             -> LockWaiting a b c
             -> (LockWaiting a b c, (Result (S.Set b), S.Set b))
 updateLocks owner req state =
-  second (second $ S.delete owner) $ updateLocks' owner req state
+  if requestFulfilled owner req state
+    then (state, (Ok S.empty, S.empty))
+    else second (second $ S.delete owner) $ updateLocks' owner req state
 
 -- | Update locks as soon as possible. If the request cannot be fulfilled
 -- immediately add the request to the waiting queue. The first argument is
 -- the priority at which the owner is waiting, the remaining are as for
 -- updateLocks, and so is the output.
+-- For convenience, fulfilled requests are always accepted.
 updateLocksWaiting :: (Lock a, Ord b, Ord c)
                    => c
                    -> b
@@ -256,7 +270,10 @@ updateLocksWaiting :: (Lock a, Ord b, Ord c)
                    -> LockWaiting a b c
                    -> (LockWaiting a b c, (Result (S.Set b), S.Set b))
 updateLocksWaiting prio owner req state =
-  second (second $ S.delete owner) $ updateLocksWaiting' prio owner req state
+  if requestFulfilled owner req state
+    then (state, (Ok S.empty, S.empty))
+     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.
-- 
GitLab