propellor-4.3.0: property-based host configuration management in haskell

Safe HaskellNone
LanguageHaskell98

Propellor

Contents

Description

When propellor runs on a Host, it ensures that its Properties are satisfied, taking action as necessary when a Property is not currently satisfied.

A simple propellor program example:

import Propellor
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt

main :: IO ()
main = defaultMain hosts

hosts :: [Host]
hosts = [example]

example :: Host
example = host "example.com" $ props
    & Apt.installed ["mydaemon"]
    & "/etc/mydaemon.conf" `File.containsLine` "secure=1"
      `onChange` cmdProperty "service" ["mydaemon", "restart"]
    ! Apt.installed ["unwantedpackage"]

See config.hs for a more complete example, and clone Propellor's git repository for a deployable system using Propellor: git clone git://git.joeyh.name/propellor

Synopsis

Core data types

data Host Source #

Everything Propellor knows about a system: Its hostname, properties and their collected info.

Constructors

Host 

data Property metatypes Source #

The core data type of Propellor, this represents a property that the system should have, with a descrition, and an action to ensure it has the property.

There are different types of properties that target different OS's, and so have different metatypes. For example: "Property DebianLike" and "Property FreeBSD".

Also, some properties have associated Info, which is indicated in their type: "Property (HasInfo + DebianLike)"

There are many associated type families, which are mostly used internally, so you needn't worry about them.

Constructors

Property metatypes Desc (Maybe (Propellor Result)) Info [ChildProperty] 

Instances

TightenTargets Property Source # 

Methods

tightenTargets :: ((CheckCombine ~ NotSuperset a (Targets a untightened) (Targets a tightened)) CanCombine, (CheckCombine ~ NotSuperset a (NonTargets a tightened) (NonTargets a untightened)) CanCombine, SingI [a] tightened) => Property (MetaTypes [a] untightened) -> Property (MetaTypes [a] tightened) Source #

Checkable Property i Source # 
Show (Property metatypes) Source # 

Methods

showsPrec :: Int -> Property metatypes -> ShowS #

show :: Property metatypes -> String #

showList :: [Property metatypes] -> ShowS #

SingI k metatypes => Monoid (Property (MetaTypes k metatypes)) Source #

Any type of Property is a monoid. When properties x and y are appended together, the resulting property has a description like "x and y". Note that when x fails to be ensured, it will not try to ensure y.

Methods

mempty :: Property (MetaTypes k metatypes) #

mappend :: Property (MetaTypes k metatypes) -> Property (MetaTypes k metatypes) -> Property (MetaTypes k metatypes) #

mconcat :: [Property (MetaTypes k metatypes)] -> Property (MetaTypes k metatypes) #

IsProp (Property metatypes) Source # 

Methods

setDesc :: Property metatypes -> Desc -> Property metatypes Source #

getDesc :: Property metatypes -> Desc Source #

getChildren :: Property metatypes -> [ChildProperty] Source #

addChildren :: Property metatypes -> [ChildProperty] -> Property metatypes Source #

getInfoRecursive :: Property metatypes -> Info Source #

getInfo :: Property metatypes -> Info Source #

toChildProperty :: Property metatypes -> ChildProperty Source #

getSatisfy :: Property metatypes -> Maybe (Propellor Result) Source #

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
type CombinedType (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) Source # 
type CombinedType (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) = Property (MetaTypes [a] (Combine a x y))
type CombinedType (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 

data RevertableProperty setupmetatypes undometatypes Source #

A property that can be reverted. The first Property is run normally and the second is run when it's reverted.

Constructors

RevertableProperty 

Fields

Instances

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
Show (RevertableProperty setupmetatypes undometatypes) Source # 

Methods

showsPrec :: Int -> RevertableProperty setupmetatypes undometatypes -> ShowS #

show :: RevertableProperty setupmetatypes undometatypes -> String #

showList :: [RevertableProperty setupmetatypes undometatypes] -> ShowS #

(Monoid (Property setupmetatypes), Monoid (Property undometatypes)) => Monoid (RevertableProperty setupmetatypes undometatypes) Source #

Any type of RevertableProperty is a monoid. When revertable properties x and y are appended together, the resulting revertable property has a description like "x and y". Note that when x fails to be ensured, it will not try to ensure y.

Methods

mempty :: RevertableProperty setupmetatypes undometatypes #

mappend :: RevertableProperty setupmetatypes undometatypes -> RevertableProperty setupmetatypes undometatypes -> RevertableProperty setupmetatypes undometatypes #

mconcat :: [RevertableProperty setupmetatypes undometatypes] -> RevertableProperty setupmetatypes undometatypes #

IsProp (RevertableProperty setupmetatypes undometatypes) Source # 

Methods

setDesc :: RevertableProperty setupmetatypes undometatypes -> Desc -> RevertableProperty setupmetatypes undometatypes Source #

getDesc :: RevertableProperty setupmetatypes undometatypes -> Desc Source #

getChildren :: RevertableProperty setupmetatypes undometatypes -> [ChildProperty] Source #

addChildren :: RevertableProperty setupmetatypes undometatypes -> [ChildProperty] -> RevertableProperty setupmetatypes undometatypes Source #

getInfoRecursive :: RevertableProperty setupmetatypes undometatypes -> Info Source #

getInfo :: RevertableProperty setupmetatypes undometatypes -> Info Source #

toChildProperty :: RevertableProperty setupmetatypes undometatypes -> ChildProperty Source #

getSatisfy :: RevertableProperty setupmetatypes undometatypes -> Maybe (Propellor Result) Source #

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a1 x y) CanCombine, (~) CheckCombine (CheckCombinable a x' y') CanCombine, SingI [a1] (Combine a1 x y), SingI [a] (Combine a x' y')) => Combines (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) Source # 
type CombinedType (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
type CombinedType (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) = RevertableProperty (MetaTypes [a1] (Combine a1 x y)) (MetaTypes [a] (Combine a x' y'))

Config file

defaultMain :: [Host] -> IO () Source #

Runs propellor on hosts, as controlled by command-line options.

host :: HostName -> Props metatypes -> Host Source #

Defines a host and its properties.

host "example.com" $ props
	& someproperty
	! oldproperty
	& otherproperty

(&) :: (IsProp p, MetaTypes y ~ GetMetaTypes p, CheckCombinable x y ~ CanCombine) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) infixl 1 Source #

Adds a property to a Props.

Can add Properties and RevertableProperties

(!) :: CheckCombinable x z ~ CanCombine => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) infixl 1 Source #

Adds a property in reverted form.

Propertries

Properties are often combined together in your propellor configuration. For example:

"/etc/foo/config" `File.containsLine` "bar=1"
	`requires` File.dirExists "/etc/foo"

requires :: Combines x y => x -> y -> CombinedType x y Source #

Indicates that the first property depends on the second, so before the first is ensured, the second must be ensured.

The combined property uses the description of the first property.

before :: Combines x y => x -> y -> CombinedType x y Source #

Combines together two properties, resulting in one property that ensures the first, and if the first succeeds, ensures the second.

The combined property uses the description of the first property.

onChange :: Combines x y => x -> y -> CombinedType x y Source #

Whenever a change has to be made for a Property, causes a hook Property to also be run, but not otherwise.

describe :: IsProp p => p -> Desc -> p Source #

Changes the description of a property.

Everything you need to build your own properties, and useful property combinators

Properties to run shell commands

Properties that set Info

Combining a list of properties into a single property

Private data access for properties