On Tue, Mar 4, 2014 at 3:42 PM, Klaus Aehlig <[email protected]> wrote:
> It will be used to persist the state of the lock allocation on > disk, allowing locks to survive reboots of WConfD. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/Locking/Locks.hs | 33 +++++++++++++++++++++++++++++++-- > 1 file changed, 31 insertions(+), 2 deletions(-) > > diff --git a/src/Ganeti/Locking/Locks.hs b/src/Ganeti/Locking/Locks.hs > index 5dc8949..5c09216 100644 > --- a/src/Ganeti/Locking/Locks.hs > +++ b/src/Ganeti/Locking/Locks.hs > @@ -1,4 +1,4 @@ > -{-# LANGUAGE ViewPatterns #-} > +{-# LANGUAGE ViewPatterns, FlexibleContexts #-} > > {-| Ganeti lock structure > > @@ -29,19 +29,25 @@ module Ganeti.Locking.Locks > ( GanetiLocks(..) > , GanetiLockAllocation > , loadLockAllocation > + , writeLocksAsyncTask > ) where > > import Control.Monad ((>=>)) > +import Control.Monad.Base (MonadBase, liftBase) > +import Control.Monad.Error (MonadError, catchError) > import Data.List (stripPrefix) > import qualified Text.JSON as J > > > import Ganeti.BasicTypes > -import Ganeti.Errors (ResultG) > +import Ganeti.Errors (ResultG, GanetiException) > import Ganeti.JSON (readEitherString, fromJResultE) > import Ganeti.Locking.Allocation > import Ganeti.Locking.Types > +import Ganeti.Logging.Lifted (MonadLog, logDebug, logEmergency) > import Ganeti.Types > +import Ganeti.Utils.Atomic > +import Ganeti.Utils.AsyncWorker > > -- | The type of Locks available in Ganeti. The order of this type > -- is the lock oder. > @@ -113,3 +119,26 @@ loadLockAllocation :: FilePath -> ResultG > GanetiLockAllocation > loadLockAllocation = > liftIO . readFile > >=> fromJResultE "parsing lock allocation" . J.decodeStrict > + > +-- | Write lock allocation to disk, overwriting any previously lock > +-- allocation stored there. > +writeLocks :: (MonadBase IO m, MonadError GanetiException m, MonadLog m) > + => FilePath -> GanetiLockAllocation -> m () > +writeLocks fpath lockAlloc = do > + logDebug "Async. lock allocation writer: Starting write" > + toErrorBase . liftIO . atomicWriteFile fpath $ J.encode lockAlloc > Just nitpicking - double space after the second "." > + logDebug "Async. lock allocation writer: written" > + > +-- | Construct an asynchronous worker whose action is to save the > +-- current state of the lock allocation. > +-- The worker's action reads the lock allocation using the given @IO@ > +-- action. Any inbetween changes to the file are tacitly ignored. > +writeLocksAsyncTask :: FilePath -- ^ Path to the lock file > + -> IO GanetiLockAllocation -- ^ An action to read the > + -- current lock allocation > + -> ResultG (AsyncWorker ()) > +writeLocksAsyncTask fpath lockAllocAction = mkAsyncWorker $ > + catchError (do > + locks <- liftBase lockAllocAction > + writeLocks fpath locks > + ) (logEmergency . (++) "Can't write lock allocation status: " . show) > -- > 1.9.0.279.gdc9e3eb > > LGTM (no need to resend)
