.. and the corresponding functions for reading/modifying them. The modification functions are somewhat more complex, because they need to support that the modification function uses ConfigData and can possibly fail (when the configuration is inconsistent).
Signed-off-by: Petr Pudlak <[email protected]> --- src/Ganeti/WConfd/Monad.hs | 45 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs index 0130b8f..07227c8 100644 --- a/src/Ganeti/WConfd/Monad.hs +++ b/src/Ganeti/WConfd/Monad.hs @@ -47,6 +47,9 @@ module Ganeti.WConfd.Monad , modifyLockWaiting , modifyLockWaiting_ , readLockAllocation + , modifyTempResState + , modifyTempResStateErr + , readTempResState ) where import Control.Applicative @@ -55,7 +58,10 @@ import Control.Monad import Control.Monad.Base import Control.Monad.Error import Control.Monad.Reader +import Control.Monad.State import Control.Monad.Trans.Control +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Identity import Data.IORef.Lifted import qualified Data.Set as S import Data.Tuple (swap) @@ -68,8 +74,10 @@ import Ganeti.Locking.Allocation (LockAllocation) import Ganeti.Locking.Locks import Ganeti.Locking.Waiting (getAllocation) import Ganeti.Logging +import Ganeti.Objects (ConfigData) import Ganeti.Utils.AsyncWorker import Ganeti.WConfd.ConfigState +import Ganeti.WConfd.TempRes -- * Pure data types used in the monad @@ -78,6 +86,7 @@ import Ganeti.WConfd.ConfigState data DaemonState = DaemonState { dsConfigState :: ConfigState , dsLockWaiting :: GanetiLockWaiting + , dsTempRes :: TempResState } $(makeCustomLenses ''DaemonState) @@ -113,7 +122,7 @@ mkDaemonHandle :: FilePath mkDaemonHandle cpath cstat lstat saveWorkerFn distMCsWorkerFn distSSConfWorkerFn saveLockWorkerFn = do - ds <- newIORef $ DaemonState cstat lstat + ds <- newIORef $ DaemonState cstat lstat emptyTempResState let readConfigIO = dsConfigState `liftM` readIORef ds :: IO ConfigState saveWorker <- saveWorkerFn readConfigIO @@ -132,6 +141,15 @@ atomicModifyWithLens :: (MonadBase IO m) => IORef a -> Lens a a b c -> (b -> (r, c)) -> m r atomicModifyWithLens ref l f = atomicModifyIORef ref (swap . traverseOf l f) +-- | Atomically modifies an 'IORef' using a function that can possibly fail. +-- If it fails, the value of the 'IORef' is preserved. +atomicModifyIORefErr :: (MonadBase IO m) + => IORef a -> (a -> GenericResult e (a, b)) + -> ResultT e m b +atomicModifyIORefErr ref f = + let f' x = genericResult ((,) x . Bad) (fmap Ok) (f x) + in ResultT $ atomicModifyIORef ref f' + -- * The monad and its instances -- | A type alias for easier referring to the actual content of the monad @@ -209,6 +227,31 @@ modifyConfigState f = do return () return r +-- | Atomically modifies the state of temporary reservations in +-- WConfdMonad in the presence of possible errors. +modifyTempResStateErr + :: (ConfigData -> StateT TempResState ErrorResult a) -> WConfdMonad a +modifyTempResStateErr f = do + -- we use Compose to traverse the composition of applicative functors + -- @ErrorResult@ and @(,) a@ + let f' ds = getCompose $ traverseOf dsTempResL + (Compose . runStateT (f (csConfigData . dsConfigState $ ds))) ds + dh <- daemonHandle + toErrorBase $ atomicModifyIORefErr (dhDaemonState dh) (liftM swap . f') + +-- | Atomically modifies the state of temporary reservations in +-- WConfdMonad. +modifyTempResState :: (ConfigData -> State TempResState a) -> WConfdMonad a +modifyTempResState f = + modifyTempResStateErr (mapStateT (return . runIdentity) . f) + +-- | Reads the state of of the configuration and temporary reservations +-- in WConfdMonad. +readTempResState :: WConfdMonad (ConfigData, TempResState) +readTempResState = liftM (csConfigData . dsConfigState &&& dsTempRes) + . readIORef . dhDaemonState + =<< daemonHandle + -- | Atomically modifies the lock waiting state in WConfdMonad. modifyLockWaiting :: (GanetiLockWaiting -> ( GanetiLockWaiting , (a, S.Set ClientId) )) -- 1.9.1.423.g4596e3a
