summaryrefslogtreecommitdiff
path: root/src/Propellor/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Types.hs')
-rw-r--r--src/Propellor/Types.hs408
1 files changed, 132 insertions, 276 deletions
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 542a1f66..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,264 +1,156 @@
-{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
-module Propellor.Types
- ( Host(..)
- , Property
- , Info
- , HasInfo
- , NoInfo
- , CInfo
+module Propellor.Types (
+ -- * Core data types
+ Host(..)
+ , Property(..)
+ , property
, Desc
- , infoProperty
- , simpleProperty
- , adjustPropertySatisfy
- , propertyInfo
- , propertyDesc
- , propertyChildren
, RevertableProperty(..)
- , MkRevertableProperty(..)
- , IsProp(..)
+ , (<!>)
+ , Propellor(..)
+ , LiftPropellor(..)
+ , Info
+ -- * Types of properties
+ , UnixLike
+ , Linux
+ , DebianLike
+ , Debian
+ , Buntish
+ , FreeBSD
+ , HasInfo
+ , type (+)
+ , TightenTargets(..)
+ -- * Combining and modifying properties
, Combines(..)
, CombinedType
, ResultCombiner
- , Propellor(..)
- , LiftPropellor(..)
- , EndAction(..)
+ , adjustPropertySatisfy
+ -- * Other included types
, 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.Core
import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Dns
import Propellor.Types.Result
+import Propellor.Types.MetaTypes
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.
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
+-- that have 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".
--
--- A property can have associated `Info` or not. This is tracked at the
--- type level with Property `NoInfo` and Property `HasInfo`.
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
--
--- There are many instances and type families, which are mostly used
+-- There are many associated 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)
+data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
--- | Constructs a Property with no Info.
-simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
-simpleProperty = SProperty
+instance Show (Property metatypes) where
+ show p = "property " ++ show (getDesc p)
-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
+-- | Constructs a Property, from a description and an action to run to
+-- ensure the Property is met.
+--
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
+--
+-- For example:
+--
+-- > foo :: Property Debian
+-- > foo = property "foo" $ do
+-- > ...
+-- > return MadeChange
+property
+ :: SingI metatypes
+ => Desc
+ -> Propellor Result
+ -> Property (MetaTypes metatypes)
+property d a = Property sing d a mempty mempty
-- | 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
+adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
+adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
-- | 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
+data RevertableProperty setupmetatypes undometatypes = RevertableProperty
+ { setupRevertableProperty :: Property setupmetatypes
+ , undoRevertableProperty :: Property undometatypes
}
-instance Show (RevertableProperty i) where
+instance Show (RevertableProperty setupmetatypes undometatypes) 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
+-- | Shorthand to construct a revertable property from any two Properties.
+(<!>)
+ :: Property setupmetatypes
+ -> Property undometatypes
+ -> RevertableProperty setupmetatypes undometatypes
+setup <!> undo = RevertableProperty setup undo
+
+instance IsProp (Property metatypes) where
+ setDesc (Property t _ a i c) d = Property t d a i c
+ getDesc (Property _ d _ _ _) = d
+ getChildren (Property _ _ _ _ c) = c
+ addChildren (Property t d a i c) c' = Property t d a i (c ++ c')
+ getInfoRecursive (Property _ _ _ i c) =
+ i <> mconcat (map getInfoRecursive c)
+ getInfo (Property _ _ _ i _) = i
+ toChildProperty (Property _ d a i c) = ChildProperty d a i c
+ getSatisfy (Property _ _ a _ _) = a
+
+instance IsProp (RevertableProperty setupmetatypes undometatypes) where
+ -- | Sets the description of both sides.
+ setDesc (RevertableProperty p1 p2) d =
+ RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
- toProp (RevertableProperty p1 _) = p1
+ getChildren (RevertableProperty p1 _) = getChildren p1
+ -- | Only add children to the active side.
+ addChildren (RevertableProperty p1 p2) c = RevertableProperty (addChildren p1 c) p2
-- | 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))
+ getInfo (RevertableProperty p1 _p2) = getInfo p1
+ toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1
+ getSatisfy (RevertableProperty p1 _) = getSatisfy p1
-- | 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)
+type instance CombinedType (Property (MetaTypes x)) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) = RevertableProperty (MetaTypes (Combine x y)) (MetaTypes (Combine 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 instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) = Property (MetaTypes (Combine 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.
+ -- has the description and info of the first, and that has the
+ -- second property as a child property.
combineWith
:: ResultCombiner
-- ^ How to combine the actions to satisfy the properties.
@@ -269,73 +161,37 @@ class Combines x y where
-> 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
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
+ combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
+ Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1)
+instance (CheckCombinable x y ~ 'CanCombine, CheckCombinable x' y' ~ 'CanCombine, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+ combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
+ RevertableProperty
+ (combineWith sf tf s1 s2)
+ (combineWith tf sf t1 t2)
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
+ combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+ combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
+
+class TightenTargets p where
+ -- | Tightens the MetaType list of a Property (or similar),
+ -- to contain fewer targets.
+ --
+ -- For example, to make a property that uses apt-get, which is only
+ -- available on DebianLike systems:
+ --
+ -- > upgraded :: Property DebianLike
+ -- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+ tightenTargets
+ ::
+ -- Note that this uses PolyKinds
+ ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine
+ , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine
+ , SingI tightened
+ )
+ => p (MetaTypes untightened)
+ -> p (MetaTypes tightened)
+
+instance TightenTargets Property where
+ tightenTargets (Property _ d a i c) = Property sing d a i c