Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / WConfd / Monad.hs @ 13d26b66

History | View | Annotate | Download (6 kB)

1
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
2

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

    
5
It encapsulates:
6

    
7
* IO operations,
8
* failures,
9
* working with the daemon state,
10
* working with the client state.
11

    
12
Code that is specific either to the configuration or the lock management, should
13
go into their corresponding dedicated modules.
14
-}
15

    
16
{-
17

    
18
Copyright (C) 2014 Google Inc.
19

    
20
This program is free software; you can redistribute it and/or modify
21
it under the terms of the GNU General Public License as published by
22
the Free Software Foundation; either version 2 of the License, or
23
(at your option) any later version.
24

    
25
This program is distributed in the hope that it will be useful, but
26
WITHOUT ANY WARRANTY; without even the implied warranty of
27
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
28
General Public License for more details.
29

    
30
You should have received a copy of the GNU General Public License
31
along with this program; if not, write to the Free Software
32
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
33
02110-1301, USA.
34

    
35
-}
36

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

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

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

    
68
-- * Pure data types used in the monad
69

    
70
-- | The state of the daemon, capturing both the configuration state and the
71
-- locking state.
72
data DaemonState = DaemonState
73
  { dsConfigState :: ConfigState
74
  , dsLockAllocation :: GanetiLockAllocation
75
  }
76

    
77
data DaemonHandle = DaemonHandle
78
  { dhDaemonState :: IORef DaemonState -- ^ The current state of the daemon
79
  , dhConfigPath :: FilePath           -- ^ The configuration file path
80
  -- all static information that doesn't change during the life-time of the
81
  -- daemon should go here;
82
  -- all IDs of threads that do asynchronous work should probably also go here
83
  , dhSaveConfigWorker :: AsyncWorker ()
84
  }
85

    
86
mkDaemonHandle :: FilePath
87
               -> ConfigState
88
               -> GanetiLockAllocation
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
97

    
98
data ClientState = ClientState
99
  { clLiveFilePath :: FilePath
100
  , clJobId :: JobId
101
  }
102

    
103
-- * The monad and its instances
104

    
105
-- | A type alias for easier referring to the actual content of the monad
106
-- when implementing its instances.
107
type WConfdMonadIntType = RWST DaemonHandle () (Maybe ClientState) IO
108

    
109
-- | The internal part of the monad without error handling.
110
newtype WConfdMonadInt a = WConfdMonadInt
111
  { getWConfdMonadInt :: WConfdMonadIntType a }
112

    
113
instance Functor WConfdMonadInt where
114
  fmap f = WConfdMonadInt . fmap f . getWConfdMonadInt
115

    
116
instance Applicative WConfdMonadInt where
117
  pure = WConfdMonadInt . pure
118
  WConfdMonadInt f <*> WConfdMonadInt k = WConfdMonadInt $ f <*> k
119

    
120
instance Monad WConfdMonadInt where
121
  return = WConfdMonadInt . return
122
  (WConfdMonadInt k) >>= f = WConfdMonadInt $ k >>= getWConfdMonadInt . f
123

    
124
instance MonadIO WConfdMonadInt where
125
  liftIO = WConfdMonadInt . liftIO
126

    
127
instance MonadBase IO WConfdMonadInt where
128
  liftBase = WConfdMonadInt . liftBase
129

    
130
instance MonadBaseControl IO WConfdMonadInt where
131
  newtype StM WConfdMonadInt b = StMWConfdMonadInt
132
    { runStMWConfdMonadInt :: StM WConfdMonadIntType b }
133
  liftBaseWith f = WConfdMonadInt . liftBaseWith
134
                   $ \r -> f (liftM StMWConfdMonadInt . r . getWConfdMonadInt)
135
  restoreM = WConfdMonadInt . restoreM . runStMWConfdMonadInt
136

    
137
instance MonadLog WConfdMonadInt where
138
  logAt p = WConfdMonadInt . logAt p
139

    
140
-- | Runs the internal part of the WConfdMonad monad on a given daemon
141
-- handle.
142
runWConfdMonadInt :: WConfdMonadInt a -> DaemonHandle -> IO a
143
runWConfdMonadInt (WConfdMonadInt k) dhandle =
144
  liftM fst $ evalRWST k dhandle Nothing
145

    
146
-- | The complete monad with error handling.
147
type WConfdMonad = ResultT GanetiException WConfdMonadInt
148

    
149
-- * Basic functions in the monad
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

    
160
-- | Atomically modifies the configuration state in the WConfdMonad.
161
modifyConfigState :: (ConfigState -> (ConfigState, a)) -> WConfdMonad a
162
modifyConfigState f = do
163
  dh <- daemonHandle
164
  -- TODO: Use lenses to modify the daemons state here
165
  let mf ds = let (cs', r) = f (dsConfigState ds)
166
              in (ds { dsConfigState = cs' }, r)
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
175

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