On Fri, Aug 22, 2014 at 02:16:11PM +0200, Niklas Hambuechen wrote:
Blocks until a a lock on the config is obtained.

Signed-off-by: Niklas Hambuechen <[email protected]>
---
src/Ganeti/WConfd/Client.hs | 28 ++++++++++++++++++++++++++++
1 file changed, 28 insertions(+)

diff --git a/src/Ganeti/WConfd/Client.hs b/src/Ganeti/WConfd/Client.hs
index 105de8e..7ed7424 100644
--- a/src/Ganeti/WConfd/Client.hs
+++ b/src/Ganeti/WConfd/Client.hs
@@ -29,8 +29,13 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

module Ganeti.WConfd.Client where

Since the patch adds function 'waitLockConfig' which is only internal to the module, I'd suggest to add an explicit export list here.


+import Control.Exception.Lifted (finally)
+
import Ganeti.THH.HsRPC
import Ganeti.Constants
+import Ganeti.JSON (unMaybeForJSON)
+import Ganeti.Locking.Locks (ClientId)
+import Ganeti.Objects (ConfigData)
import Ganeti.UDSServer (ConnectConfig(..), Client, connectClient)
import Ganeti.WConfd.Core (exportedFunctions)

@@ -50,3 +55,26 @@ wconfdConnectConfig = ConnectConfig { recvTmo    = 
wconfdDefRwto
-- configuration and timeout.
getWConfdClient :: FilePath -> IO Client
getWConfdClient = connectClient wconfdConnectConfig wconfdDefCtmo
+
+-- * Helper functions for getting a remote lock
+
+-- | Calls the `lockConfig` RPC until the (unshared) log is obtained.

s#(unshared) log#shared/exclusive lock#

+waitLockConfig :: ClientId
+               -> Bool  -- ^ whether the lock shall be in shared mode
+               -> RpcClientMonad ConfigData
+waitLockConfig c shared = do
+  mConfigData <- lockConfig c shared
+  case unMaybeForJSON mConfigData of
+    Just configData -> return configData
+    Nothing         -> waitLockConfig c shared
+
+-- | Calls the `lockConfig` RPC until the (unshared) log is obtained,
+-- runs a function on the obtained config, and calls `unlockConfig`.
+withLockedConfig :: ClientId
+                 -> Bool  -- ^ whether the lock shall be in shared mode
+                 -> (ConfigData -> RpcClientMonad a)  -- ^ action to run
+                 -> RpcClientMonad a
+withLockedConfig c shared f
+  = (waitLockConfig c shared >>= f)
+    `finally`
+    unlockConfig c  -- Unlock config even if something throws.

While it's correct, (as discussed in person) this might be better expressed using `bracket`, which better expresses the intention "get some resource, run an action, release the resource".

--
2.1.0.rc2.206.gedb03e5

Reply via email to