summaryrefslogtreecommitdiff
path: root/src/Propellor/Types.hs
blob: 542a1f662a25b881963ecead5be4ebe85c24b917 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Propellor.Types
	( Host(..)
	, Property
	, Info
	, HasInfo
	, NoInfo
	, CInfo
	, Desc
	, infoProperty
	, simpleProperty
	, adjustPropertySatisfy
	, propertyInfo
	, propertyDesc
	, propertyChildren
	, RevertableProperty(..)
	, MkRevertableProperty(..)
	, IsProp(..)
	, Combines(..)
	, CombinedType
	, ResultCombiner
	, Propellor(..)
	, LiftPropellor(..)
	, EndAction(..)
	, module Propellor.Types.OS
	, module Propellor.Types.Dns
	, module Propellor.Types.Result
	, module Propellor.Types.ZFS
	, propertySatisfy
	, ignoreInfo
	) where

import Data.Monoid
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Data.Typeable
import Control.Applicative
import Prelude

import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Dns
import Propellor.Types.Result
import Propellor.Types.ZFS

-- | Everything Propellor knows about a system: Its hostname,
-- properties and their collected info.
data Host = Host
	{ hostName :: HostName
	, hostProperties :: [Property HasInfo]
	, hostInfo :: Info
	}
	deriving (Show, Typeable)

-- | Propellor's monad provides read-only access to info about the host
-- it's running on, and a writer to accumulate EndActions.
newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
	deriving
		( Monad
		, Functor
		, Applicative
		, MonadReader Host
		, MonadWriter [EndAction]
		, MonadIO
		, MonadCatch
		, MonadThrow
		, MonadMask
		)

class LiftPropellor m where
	liftPropellor :: m a -> Propellor a

instance LiftPropellor Propellor where
	liftPropellor = id

instance LiftPropellor IO where
	liftPropellor = liftIO

instance Monoid (Propellor Result) where
	mempty = return NoChange
	-- | The second action is only run if the first action does not fail.
	mappend x y = do
		rx <- x
		case rx of
			FailedChange -> return FailedChange
			_ -> do
				ry <- y
				return (rx <> ry)

-- | An action that Propellor runs at the end, after trying to satisfy all
-- properties. It's passed the combined Result of the entire Propellor run.
data EndAction = EndAction Desc (Result -> Propellor Result)

type Desc = String

-- | The core data type of Propellor, this represents a property
-- that the system should have, and an action to ensure it has the
-- property.
--
-- A property can have associated `Info` or not. This is tracked at the
-- type level with Property `NoInfo` and Property `HasInfo`.
--
-- There are many instances and type families, which are mostly used
-- internally, so you needn't worry about them.
data Property i where
	IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
	SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo

-- | Indicates that a Property has associated Info.
data HasInfo
-- | Indicates that a Property does not have Info.
data NoInfo

-- | Type level calculation of the combination of HasInfo and/or NoInfo
type family CInfo x y
type instance CInfo HasInfo HasInfo = HasInfo
type instance CInfo HasInfo NoInfo = HasInfo
type instance CInfo NoInfo HasInfo = HasInfo
type instance CInfo NoInfo NoInfo = NoInfo

-- | Constructs a Property with associated Info.
infoProperty
	:: Desc -- ^ description of the property
	-> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly)
	-> Info -- ^ info associated with the property
	-> [Property i] -- ^ child properties
	-> Property HasInfo
infoProperty d a i cs = IProperty d a i (map toIProperty cs)

-- | Constructs a Property with no Info.
simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
simpleProperty = SProperty

toIProperty :: Property i -> Property HasInfo
toIProperty p@(IProperty {}) = p
toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)

toSProperty :: Property i -> Property NoInfo
toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
toSProperty p@(SProperty {}) = p

-- | Makes a version of a Proprty without its Info.
-- Use with caution!
ignoreInfo :: Property i -> Property NoInfo
ignoreInfo = toSProperty

-- | Gets the action that can be run to satisfy a Property.
-- You should never run this action directly. Use
-- 'Propellor.Engine.ensureProperty` instead.
propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a

-- | Changes the action that is performed to satisfy a property.
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs

propertyInfo :: Property i -> Info
propertyInfo (IProperty _ _ i _) = i
propertyInfo (SProperty {}) = mempty

propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d

instance Show (Property i) where
	show p = "property " ++ show (propertyDesc p)

-- | A Property can include a list of child properties that it also
-- satisfies. This allows them to be introspected to collect their info, etc.
propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs

-- | A property that can be reverted. The first Property is run
-- normally and the second is run when it's reverted.
data RevertableProperty i = RevertableProperty
	{ setupRevertableProperty :: Property i
	, undoRevertableProperty :: Property i
	}

instance Show (RevertableProperty i) where
	show (RevertableProperty p _) = show p

class MkRevertableProperty i1 i2 where
	-- | Shorthand to construct a revertable property.
	(<!>) :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)

instance MkRevertableProperty HasInfo HasInfo where
	x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo NoInfo where
	x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo HasInfo where
	x <!> y = RevertableProperty (toProp x) y
instance MkRevertableProperty HasInfo NoInfo where
	x <!> y = RevertableProperty x (toProp y)

-- | Class of types that can be used as properties of a host.
class IsProp p where
	setDesc :: p -> Desc -> p
	toProp :: p -> Property HasInfo
	getDesc :: p -> Desc
	-- | Gets the info of the property, combined with all info
	-- of all children properties.
	getInfoRecursive :: p -> Info

instance IsProp (Property HasInfo) where
	setDesc (IProperty _ a i cs) d = IProperty d a i cs
	toProp = id
	getDesc = propertyDesc
	getInfoRecursive (IProperty _ _ i cs) =
		i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where
	setDesc (SProperty _ a cs) d = SProperty d a cs
	toProp = toIProperty
	getDesc = propertyDesc
	getInfoRecursive _ = mempty

instance IsProp (RevertableProperty HasInfo) where
	setDesc = setDescR
	getDesc (RevertableProperty p1 _) = getDesc p1
	toProp (RevertableProperty p1 _) = p1
	-- | Return the Info of the currently active side.
	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
instance IsProp (RevertableProperty NoInfo) where
	setDesc = setDescR
	getDesc (RevertableProperty p1 _) = getDesc p1
	toProp (RevertableProperty p1 _) = toProp p1
	getInfoRecursive (RevertableProperty _ _) = mempty

-- | Sets the description of both sides.
setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
setDescR (RevertableProperty p1 p2) d =
	RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))

-- | Type level calculation of the type that results from combining two
-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
-- When only one of the properties is revertable, the combined property is
-- not fully revertable, so is not a RevertableProperty.
type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)

type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result

class Combines x y where
	-- | Combines together two properties, yielding a property that
	-- has the description and info of the first, and that has the second
	-- property as a child.
	combineWith
		:: ResultCombiner
		-- ^ How to combine the actions to satisfy the properties.
		-> ResultCombiner
		-- ^ Used when combining revertable properties, to combine
		-- their reversion actions.
		-> x
		-> y
		-> CombinedType x y

instance Combines (Property HasInfo) (Property HasInfo) where
	combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
		IProperty d1 (f a1 a2) i1 (y : cs1)

instance Combines (Property HasInfo) (Property NoInfo) where
	combineWith f _ (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
		IProperty d1 (f a1 a2) i1 (toIProperty y : cs1)

instance Combines (Property NoInfo) (Property HasInfo) where
	combineWith f _ (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
		IProperty d1 (f a1 a2) mempty (y : map toIProperty cs1)

instance Combines (Property NoInfo) (Property NoInfo) where
	combineWith f _ (SProperty d1 a1  cs1) y@(SProperty _d2 a2 _cs2) =
		SProperty d1 (f a1 a2) (y : cs1)

instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
	combineWith = combineWithRP
instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithPR
instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithPR

combineWithRR
	:: Combines (Property x) (Property y)
	=> ResultCombiner
	-> ResultCombiner
	-> RevertableProperty x
	-> RevertableProperty y
	-> RevertableProperty (CInfo x y)
combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
	RevertableProperty
		(combineWith sf tf s1 s2)
		(combineWith tf sf t1 t2)

combineWithRP
	:: Combines (Property i) y
	=> (Propellor Result -> Propellor Result -> Propellor Result)
	-> (Propellor Result -> Propellor Result -> Propellor Result)
	-> RevertableProperty i
	-> y
	-> CombinedType (Property i) y
combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y

combineWithPR
	:: Combines x (Property i)
	=> (Propellor Result -> Propellor Result -> Propellor Result)
	-> (Propellor Result -> Propellor Result -> Propellor Result)
	-> x
	-> RevertableProperty i
	-> CombinedType x (Property i)
combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y