summaryrefslogtreecommitdiff
path: root/src/Propellor/Types.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-28 05:53:38 -0400
committerJoey Hess2016-03-28 05:55:48 -0400
commita1655d24bbb1db9caccdf93eae8110d746389ae2 (patch)
tree66b6890d852c19daec2306920fecf9108e055273 /src/Propellor/Types.hs
parentebf30061d8f8a251330070e69c2710fe4a8fd9da (diff)
type safe targets for properties
* Property types have been improved to indicate what systems they target. This prevents using eg, Property FreeBSD on a Debian system. Transition guide for this sweeping API change: - Change "host name & foo & bar" to "host name $ props & foo & bar" - Similarly, `propertyList` and `combineProperties` need `props` to be used to combine together properties; they no longer accept lists of properties. (If you have such a list, use `toProps`.) - And similarly, Chroot, Docker, and Systemd container need `props` to be used to combine together the properies used inside them. - The `os` property is removed. Instead use `osDebian`, `osBuntish`, or `osFreeBSD`. These tell the type checker the target OS of a host. - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to "RevertableProperty UnixLike UnixLike" - Change "RevertableProperty HasInfo" to "RevertableProperty (HasInfo + UnixLike) UnixLike" - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types. This is enabled by default for all modules in propellor.cabal. But if you are using propellor as a library, you may need to enable it manually. - If you know a property only works on a particular OS, like Debian or FreeBSD, use that instead of "UnixLike". For example: "Property Debian" - It's also possible make a property support a set of OS's, for example: "Property (Debian + FreeBSD)" - Removed `infoProperty` and `simpleProperty` constructors, instead use `property` to construct a Property. - Due to the polymorphic type returned by `property`, additional type signatures tend to be needed when using it. For example, this will fail to type check, because the type checker cannot guess what type you intend the intermediate property "go" to have: foo :: Property UnixLike foo = go `requires` bar where go = property "foo" (return NoChange) To fix, specify the type of go: go :: Property UnixLike - `ensureProperty` now needs to be passed a witness to the type of the property it's used in. change this: foo = property desc $ ... ensureProperty bar to this: foo = property' desc $ \w -> ... ensureProperty w bar - General purpose properties like cmdProperty have type "Property UnixLike". When using that to run a command only available on Debian, you can tighten the type to only the OS that your more specific property works on. For example: upgraded :: Property Debian upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - Several utility functions have been renamed: getInfo to fromInfo propertyInfo to getInfo propertyDesc to getDesc propertyChildren to getChildren * The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses which to use based on the Host's OS. * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling these complex new types. * Added dependency on concurrent-output; removed embedded copy.
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