Revision 13d26b66 src/Ganeti/WConfd/Monad.hs

b/src/Ganeti/WConfd/Monad.hs
1
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
1
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
2 2

  
3 3
{-| All RPC calls are run within this monad.
4 4

  
......
37 37
module Ganeti.WConfd.Monad
38 38
  ( DaemonHandle
39 39
  , dhConfigPath
40
  , dhSaveConfigWorker
40 41
  , mkDaemonHandle
41 42
  , ClientState(..)
42 43
  , WConfdMonadInt
43 44
  , runWConfdMonadInt
44 45
  , WConfdMonad
46
  , daemonHandle
45 47
  , modifyConfigState
48
  , readConfigState
46 49
  , modifyLockAllocation
47 50
  ) where
48 51

  
......
52 55
import Control.Monad.Error
53 56
import Control.Monad.Trans.Control
54 57
import Control.Monad.Trans.RWS.Strict
55
import Data.IORef
58
import Data.IORef.Lifted
56 59

  
57 60
import Ganeti.BasicTypes
58 61
import Ganeti.Errors
59 62
import Ganeti.Locking.Locks
60 63
import Ganeti.Logging
61 64
import Ganeti.Types
65
import Ganeti.Utils.AsyncWorker
62 66
import Ganeti.WConfd.ConfigState
63 67

  
64 68
-- * Pure data types used in the monad
......
76 80
  -- all static information that doesn't change during the life-time of the
77 81
  -- daemon should go here;
78 82
  -- all IDs of threads that do asynchronous work should probably also go here
83
  , dhSaveConfigWorker :: AsyncWorker ()
79 84
  }
80 85

  
81 86
mkDaemonHandle :: FilePath
82 87
               -> ConfigState
83 88
               -> GanetiLockAllocation
84
               -> ResultT GanetiException IO DaemonHandle
85
mkDaemonHandle cp cs la =
86
  DaemonHandle <$> liftBase (newIORef $ DaemonState cs la) <*> pure cp
89
               -> (IO ConfigState -> ResultG (AsyncWorker ()))
90
                  -- ^ A function that creates a worker that asynchronously
91
                  -- saves the configuration to the master file.
92
               -> ResultG DaemonHandle
93
mkDaemonHandle cpath cstat lstat saveWorkerFn = do
94
  ds <- newIORef $ DaemonState cstat lstat
95
  saveWorker <- saveWorkerFn $ dsConfigState `liftM` readIORef ds
96
  return $ DaemonHandle ds cpath saveWorker
87 97

  
88 98
data ClientState = ClientState
89 99
  { clLiveFilePath :: FilePath
......
138 148

  
139 149
-- * Basic functions in the monad
140 150

  
151
-- | Returns the daemon handle.
152
daemonHandle :: WConfdMonad DaemonHandle
153
daemonHandle = lift . WConfdMonadInt $ ask
154

  
155
-- | Returns the current configuration, given a handle
156
readConfigState :: WConfdMonad ConfigState
157
readConfigState = liftM dsConfigState . readIORef . dhDaemonState
158
                  =<< daemonHandle
159

  
141 160
-- | Atomically modifies the configuration state in the WConfdMonad.
142 161
modifyConfigState :: (ConfigState -> (ConfigState, a)) -> WConfdMonad a
143 162
modifyConfigState f = do
144
  dh <- lift . WConfdMonadInt $ ask
163
  dh <- daemonHandle
145 164
  -- TODO: Use lenses to modify the daemons state here
146 165
  let mf ds = let (cs', r) = f (dsConfigState ds)
147 166
              in (ds { dsConfigState = cs' }, r)
148
  liftBase $ atomicModifyIORef (dhDaemonState dh) mf
167
  r <- atomicModifyIORef (dhDaemonState dh) mf
168
  -- trigger the config. saving worker and wait for it
169
  logDebug "Triggering config write"
170
  liftBase . triggerAndWait . dhSaveConfigWorker $ dh
171
  logDebug "Config write finished"
172
  -- trigger the config. distribution worker asynchronously
173
  -- TODO
174
  return r
149 175

  
150 176
-- | Atomically modifies the lock allocation state in WConfdMonad.
151 177
modifyLockAllocation :: (GanetiLockAllocation -> (GanetiLockAllocation, a))
......
154 180
  dh <- lift . WConfdMonadInt $ ask
155 181
  let mf ds = let (la', r) = f (dsLockAllocation ds)
156 182
              in (ds { dsLockAllocation = la' }, r)
157
  liftBase $ atomicModifyIORef (dhDaemonState dh) mf
183
  atomicModifyIORef (dhDaemonState dh) mf
184
  -- TODO: Trigger the async. lock saving worker

Also available in: Unified diff