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
|
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Propellor.Types where
import Data.Monoid
import Control.Applicative
import System.Console.ANSI
import "mtl" Control.Monad.Reader
import "MonadCatchIO-transformers" Control.Monad.CatchIO
type HostName = String
type GroupName = String
type UserName = String
-- | The core data type of Propellor, this reprecents a property
-- that the system should have, and an action to ensure it has the
-- property.
data Property = Property
{ propertyDesc :: Desc
-- | must be idempotent; may run repeatedly
, propertySatisfy :: Propellor Result
}
-- | A property that can be reverted.
data RevertableProperty = RevertableProperty Property Property
-- | Propellor's monad provides read-only access to attributes of the
-- system.
newtype Propellor p = Propellor { runWithHostAttr :: ReaderT HostAttr IO p }
deriving
( Monad
, Functor
, Applicative
, MonadReader HostAttr
, MonadIO
, MonadCatchIO
)
-- | The attributes of a system. For example, its hostname.
newtype HostAttr = HostAttr
{ _hostname :: HostName
}
mkHostAttr :: HostName -> HostAttr
mkHostAttr = HostAttr
getHostName :: Propellor HostName
getHostName = asks _hostname
class IsProp p where
-- | Sets description.
describe :: p -> Desc -> p
toProp :: p -> Property
-- | Indicates that the first property can only be satisfied
-- once the second one is.
requires :: p -> Property -> p
instance IsProp Property where
describe p d = p { propertyDesc = d }
toProp p = p
x `requires` y = Property (propertyDesc x) $ do
r <- propertySatisfy y
case r of
FailedChange -> return FailedChange
_ -> propertySatisfy x
instance IsProp RevertableProperty where
-- | Sets the description of both sides.
describe (RevertableProperty p1 p2) d =
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
toProp (RevertableProperty p1 _) = p1
(RevertableProperty p1 p2) `requires` y =
RevertableProperty (p1 `requires` y) p2
type Desc = String
data Result = NoChange | MadeChange | FailedChange
deriving (Read, Show, Eq)
instance Monoid Result where
mempty = NoChange
mappend FailedChange _ = FailedChange
mappend _ FailedChange = FailedChange
mappend MadeChange _ = MadeChange
mappend _ MadeChange = MadeChange
mappend NoChange NoChange = NoChange
-- | High level descritption of a operating system.
data System = System Distribution Architecture
deriving (Show)
data Distribution
= Debian DebianSuite
| Ubuntu Release
deriving (Show)
data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
deriving (Show, Eq)
type Release = String
type Architecture = String
-- | Results of actions, with color.
class ActionResult a where
getActionResult :: a -> (String, ColorIntensity, Color)
instance ActionResult Bool where
getActionResult False = ("failed", Vivid, Red)
getActionResult True = ("done", Dull, Green)
instance ActionResult Result where
getActionResult NoChange = ("ok", Dull, Green)
getActionResult MadeChange = ("done", Vivid, Green)
getActionResult FailedChange = ("failed", Vivid, Red)
data CmdLine
= Run HostName
| Spin HostName
| Boot HostName
| Set HostName PrivDataField
| AddKey String
| Continue CmdLine
| Chain HostName
| Docker HostName
deriving (Read, Show, Eq)
-- | Note that removing or changing field names will break the
-- serialized privdata files, so don't do that!
-- It's fine to add new fields.
data PrivDataField
= DockerAuthentication
| SshPrivKey UserName
| Password UserName
| PrivFile FilePath
deriving (Read, Show, Ord, Eq)
|
