Revision e45eeb79
b/src/Ganeti/WConfd/Monad.hs | ||
---|---|---|
1 | 1 |
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} |
2 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 | 3 |
|
3 | 4 |
{-| All RPC calls are run within this monad. |
4 | 5 |
|
... | ... | |
56 | 57 |
import Control.Monad.Reader |
57 | 58 |
import Control.Monad.Trans.Control |
58 | 59 |
import Data.IORef.Lifted |
60 |
import Data.Tuple (swap) |
|
59 | 61 |
|
60 | 62 |
import Ganeti.BasicTypes |
61 | 63 |
import Ganeti.Errors |
64 |
import Ganeti.Lens |
|
62 | 65 |
import Ganeti.Locking.Locks |
63 | 66 |
import Ganeti.Logging |
64 | 67 |
import Ganeti.Utils.AsyncWorker |
... | ... | |
73 | 76 |
, dsLockAllocation :: GanetiLockAllocation |
74 | 77 |
} |
75 | 78 |
|
79 |
$(makeCustomLenses ''DaemonState) |
|
80 |
|
|
76 | 81 |
data DaemonHandle = DaemonHandle |
77 | 82 |
{ dhDaemonState :: IORef DaemonState -- ^ The current state of the daemon |
78 | 83 |
, dhConfigPath :: FilePath -- ^ The configuration file path |
... | ... | |
159 | 164 |
modifyConfigState :: (ConfigState -> (ConfigState, a)) -> WConfdMonad a |
160 | 165 |
modifyConfigState f = do |
161 | 166 |
dh <- daemonHandle |
162 |
-- TODO: Use lenses to modify the daemons state here |
|
163 |
let mf ds = let cs = dsConfigState ds |
|
164 |
(cs', r) = f cs |
|
165 |
in (ds { dsConfigState = cs' }, (r, cs /= cs')) |
|
166 |
(r, modified) <- atomicModifyIORef (dhDaemonState dh) mf |
|
167 |
let modCS cs = let (cs', r) = f cs |
|
168 |
in ((r, cs /= cs'), cs') |
|
169 |
let mf = traverseOf dsConfigStateL modCS |
|
170 |
(r, modified) <- atomicModifyIORef (dhDaemonState dh) (swap . mf) |
|
167 | 171 |
when modified $ do |
168 | 172 |
-- trigger the config. saving worker and wait for it |
169 | 173 |
logDebug "Triggering config write" |
... | ... | |
178 | 182 |
-> WConfdMonad a |
179 | 183 |
modifyLockAllocation f = do |
180 | 184 |
dh <- lift . WConfdMonadInt $ ask |
181 |
let mf ds = let (la', r) = f (dsLockAllocation ds) |
|
182 |
in (ds { dsLockAllocation = la' }, r) |
|
183 |
r <- atomicModifyIORef (dhDaemonState dh) mf |
|
185 |
r <- atomicModifyIORef (dhDaemonState dh) |
|
186 |
(swap . traverseOf dsLockAllocationL (swap . f)) |
|
184 | 187 |
logDebug "Triggering lock state write" |
185 | 188 |
liftBase . triggerAndWait . dhSaveLocksWorker $ dh |
186 | 189 |
logDebug "Lock write finished" |
Also available in: Unified diff