diff options
| -rw-r--r-- | debian/changelog | 34 | ||||
| -rw-r--r-- | src/Propellor/Base.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Engine.hs | 16 | ||||
| -rw-r--r-- | src/Propellor/EnsureProperty.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/PrivData.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/PropAccum.hs | 9 | ||||
| -rw-r--r-- | src/Propellor/Property.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Property/Chroot.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Concurrent.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/List.hs | 100 | ||||
| -rw-r--r-- | src/Propellor/Types.hs | 20 |
12 files changed, 91 insertions, 108 deletions
diff --git a/debian/changelog b/debian/changelog index ead6585e..b27559bd 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,37 +1,43 @@ propellor (3.0.0) UNRELEASED; urgency=medium * Property types have been improved to indicate what systems they target. - This allows, eg, Property Debian to not be used on a FreeBSD system. + 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, Chroot and Docker need `props` to be used to combine + together the properies used inside them. + - And similarly, `propertyList` and `combineProperties` need `props` + to be used to combine together properties; lists of properties will + no longer work. - 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 new type signatures. + - 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 (HasInfo + Debian)" + "Property Debian" - It's also possible make a property support a set of OS's, for example: - "Property (HasInfo + Debian + FreeBSD)" - - `ensureProperty` now needs information about the metatypes of the - property it's used in to be passed to it. See the documentation - of `ensureProperty` for an example, but basically, change - this: foo = property desc $ ... ensureProperty bar - to this: foo = property' desc $ \o -> ... ensureProperty o bar + "Property (Debian + FreeBSD)" + - `ensureProperty` now needs to be passed information about the + property it's used in. + change this: foo = property desc $ ... ensureProperty bar + to this: foo = property' desc $ \o -> ... ensureProperty o 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 targets to only the OS that your more specific - property works on. For example: + 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"]) - - The new `pickOS` property combinator can be used to combine different - properties, supporting different OS's, into one Property that chooses - what to do based on the Host's OS. + * The new `pickOS` property combinator can be used to combine different + properties, supporting different OS's, into one Property that chooses + what to do based on the Host's OS. -- Joey Hess <id@joeyh.name> Thu, 24 Mar 2016 15:02:33 -0400 diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs index e50adf10..4afad2ab 100644 --- a/src/Propellor/Base.hs +++ b/src/Propellor/Base.hs @@ -9,7 +9,7 @@ module Propellor.Base ( , module Propellor.Property.Cmd --, module Propellor.Property.List , module Propellor.Types.PrivData - --, module Propellor.PropAccum + , module Propellor.PropAccum , module Propellor.Info , module Propellor.PrivData --, module Propellor.Engine @@ -43,7 +43,7 @@ import Propellor.Message import Propellor.Debug import Propellor.Exception import Propellor.Info ---import Propellor.PropAccum +import Propellor.PropAccum import Propellor.Location import Propellor.Utilities diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 2e914d67..62fad5af 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -2,10 +2,10 @@ {-# LANGUAGE GADTs #-} module Propellor.Engine ( - mainProperties, + -- mainProperties, runPropellor, ensureProperty, - ensureProperties, + ensureChildProperties, fromHost, fromHost', onlyProcess, @@ -29,6 +29,8 @@ import Propellor.Info import Propellor.Property import Utility.Exception +{- + -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done. mainProperties :: Host -> IO () @@ -42,6 +44,8 @@ mainProperties host = do where ps = map ignoreInfo $ hostProperties host +-} + -- | Runs a Propellor action with the specified host. -- -- If the Result is not FailedChange, any EndActions @@ -58,14 +62,14 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc (ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host () return ret --- | Ensures a list of Properties, with a display of each as it runs. -ensureProperties :: [Property NoInfo] -> Propellor Result -ensureProperties ps = ensure ps NoChange +-- | Ensures the child properties, with a display of each as it runs. +ensureChildProperties :: [ChildProperty] -> Propellor Result +ensureChildProperties ps = ensure ps NoChange where ensure [] rs = return rs ensure (p:ls) rs = do hn <- asks hostName - r <- actionMessageOn hn (propertyDesc p) (ensureProperty p) + r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p) ensure ls (r <> rs) -- | Lifts an action into the context of a different host. diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index f42003c0..21f8acce 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -39,7 +39,7 @@ ensureProperty => OuterMetaTypes outer -> Property (MetaTypes inner) -> Propellor Result -ensureProperty _ = catchPropellor . propertySatisfy +ensureProperty _ = catchPropellor . getSatisfy -- The name of this was chosen to make type errors a more understandable. type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index bc61c538..5e6e0869 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -129,7 +129,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a -> return FailedChange addinfo p = Property undefined -- FIXME: should use sing here (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p `addInfo` privset) (propertyChildren p) privset = PrivInfo $ S.fromList $ diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index fb38e260..8177b97b 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -36,8 +36,9 @@ host hn (Props i c) = Host hn c i -- metatypes and info. data Props metatypes = Props Info [ChildProperty] --- | Start constructing a Props. Properties can then be added to it using --- `(&)` etc. +-- | Start accumulating a list of properties. +-- +-- Properties can be added to it using `(&)` etc. props :: Props UnixLike props = Props mempty [] @@ -102,7 +103,7 @@ propagateContainer propagateContainer containername c prop = Property undefined (propertyDesc prop) - (propertySatisfy prop) + (getSatisfy prop) (propertyInfo prop) (propertyChildren prop ++ hostprops) where @@ -111,6 +112,6 @@ propagateContainer containername c prop = Property let i = mapInfo (forceHostContext containername) (propagatableInfo (propertyInfo p)) cs = map go (propertyChildren p) - in infoProperty (propertyDesc p) (propertySatisfy p) i cs + in infoProperty (propertyDesc p) (getSatisfy p) i cs -} diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 582b7cfb..8999d8d8 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -255,8 +255,8 @@ isNewerThan x y = do tightenTargets :: -- Note that this uses PolyKinds - ( (Targets old `NotSuperset` Targets new) ~ 'CanCombineTargets - , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets + ( (Targets old `NotSuperset` Targets new) ~ 'CanCombine + , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine , SingI new ) => Property (MetaTypes old) diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 378836e8..fb05d659 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -148,7 +148,7 @@ propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p' where p' = infoProperty (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p <> chrootInfo c) (propertyChildren p) diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs index 74afecc4..8d608a54 100644 --- a/src/Propellor/Property/Concurrent.hs +++ b/src/Propellor/Property/Concurrent.hs @@ -97,7 +97,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps (p:rest) -> return (rest, Just p) case v of Nothing -> return r - -- This use of propertySatisfy does not lose any + -- This use of getSatisfy does not lose any -- Info asociated with the property, because -- concurrentList sets all the properties as -- children, and so propigates their info. @@ -105,7 +105,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps hn <- asks hostName r' <- actionMessageOn hn (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) worker q (r <> r') -- | Run an action with the number of capabiities increased as necessary to diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index ebc0b301..c2c131c7 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -178,7 +178,7 @@ propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p' where p' = infoProperty (propertyDesc p) - (propertySatisfy p) + (getSatisfy p) (propertyInfo p <> dockerinfo) (propertyChildren p) dockerinfo = dockerInfo $ diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index 74aa6ca6..b4a72fa8 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -1,86 +1,54 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module Propellor.Property.List ( props, - PropertyList(..), - PropertyListType, - PropList(..), + Props, + propertyList, + combineProperties, ) where import Propellor.Types +import Propellor.Types.MetaTypes import Propellor.Engine import Propellor.PropAccum +import Propellor.Exception import Data.Monoid --- | Starts accumulating a list of properties. +-- | Combines a list of properties, resulting in a single property +-- that when run will run each property in the list in turn, +-- and print out the description of each as it's run. Does not stop +-- on failure; does propagate overall success/failure. +-- +-- For example: -- -- > propertyList "foo" $ props --- > & someproperty --- > ! oldproperty --- > & otherproperty -props :: PropList -props = PropList [] - -data PropList = PropList [Property HasInfo] - -instance PropAccum PropList where - PropList l `addProp` p = PropList (toProp p : l) - PropList l `addPropFront` p = PropList (l ++ [toProp p]) - getProperties (PropList l) = reverse l - -class PropertyList l where - -- | Combines a list of properties, resulting in a single property - -- that when run will run each property in the list in turn, - -- and print out the description of each as it's run. Does not stop - -- on failure; does propagate overall success/failure. - -- - -- Note that Property HasInfo and Property NoInfo are not the same - -- type, and so cannot be mixed in a list. To make a list of - -- mixed types, which can also include RevertableProperty, - -- use `props` - propertyList :: Desc -> l -> Property (PropertyListType l) - - -- | Combines a list of properties, resulting in one property that - -- ensures each in turn. Stops if a property fails. - combineProperties :: Desc -> l -> Property (PropertyListType l) - --- | Type level function to calculate whether a PropertyList has Info. -type family PropertyListType t -type instance PropertyListType [Property HasInfo] = HasInfo -type instance PropertyListType [Property NoInfo] = NoInfo -type instance PropertyListType [RevertableProperty NoInfo] = NoInfo -type instance PropertyListType [RevertableProperty HasInfo] = HasInfo -type instance PropertyListType PropList = HasInfo - -instance PropertyList [Property NoInfo] where - propertyList desc ps = simpleProperty desc (ensureProperties ps) ps - combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps - -instance PropertyList [Property HasInfo] where - -- It's ok to use ignoreInfo here, because the ps are made the - -- child properties of the property, and so their info is visible - -- that way. - propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps - combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps - -instance PropertyList [RevertableProperty HasInfo] where - propertyList desc ps = propertyList desc (map setupRevertableProperty ps) - combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps) - -instance PropertyList [RevertableProperty NoInfo] where - propertyList desc ps = propertyList desc (map setupRevertableProperty ps) - combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps) +-- > & bar +-- > & baz +propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) +propertyList desc (Props _i ps) = + property desc (ensureChildProperties cs) + `modifyChildren` (++ cs) + where + cs = map toProp ps -instance PropertyList PropList where - propertyList desc = propertyList desc . getProperties - combineProperties desc = combineProperties desc . getProperties +-- | Combines a list of properties, resulting in one property that +-- ensures each in turn. Stops if a property fails. +combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) +combineProperties desc (Props _i ps) = + property desc (combineSatisfy cs NoChange) + `modifyChildren` (++ cs) + where + cs = map toProp ps -combineSatisfy :: [Property i] -> Result -> Propellor Result +combineSatisfy :: [ChildProperty] -> Result -> Propellor Result combineSatisfy [] rs = return rs -combineSatisfy (l:ls) rs = do - r <- ensureProperty $ ignoreInfo l +combineSatisfy (p:ps) rs = do + r <- catchPropellor $ getSatisfy p case r of FailedChange -> return FailedChange - _ -> combineSatisfy ls (r <> rs) + _ -> combineSatisfy ps (r <> rs) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 42c12492..db05e100 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -14,6 +14,7 @@ module Propellor.Types , Info , Desc , MetaType(..) + , MetaTypes , OS(..) , UnixLike , Debian @@ -41,8 +42,6 @@ module Propellor.Types , module Propellor.Types.Dns , module Propellor.Types.Result , module Propellor.Types.ZFS - , propertySatisfy - , MetaTypes ) where import Data.Monoid @@ -169,12 +168,6 @@ ignoreInfo = -} --- | Gets the action that can be run to satisfy a Property. --- You should never run this action directly. Use --- 'Propellor.EnsureProperty.ensureProperty` instead. -propertySatisfy :: Property metatypes -> Propellor Result -propertySatisfy (Property _ _ a _ _) = a - -- | Changes the action that is performed to satisfy a property. adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c @@ -214,34 +207,45 @@ setup <!> undo = RevertableProperty setup undo class IsProp p where setDesc :: p -> Desc -> p getDesc :: p -> Desc + modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p -- | Gets the info of the property, combined with all info -- of all children properties. getInfoRecursive :: p -> Info toProp :: p -> ChildProperty + -- | Gets the action that can be run to satisfy a Property. + -- You should never run this action directly. Use + -- 'Propellor.EnsureProperty.ensureProperty` instead. + getSatisfy :: p -> Propellor Result instance IsProp (Property metatypes) where setDesc (Property t _ a i c) d = Property t d a i c getDesc = propertyDesc + modifyChildren (Property t d a i c) f = Property t d a i (f c) getInfoRecursive (Property _ _ _ i c) = i <> mconcat (map getInfoRecursive c) toProp (Property _ d a i c) = ChildProperty d a i c + getSatisfy (Property _ _ a _ _) = a instance IsProp ChildProperty where setDesc (ChildProperty _ a i c) d = ChildProperty d a i c getDesc (ChildProperty d _ _ _) = d + modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c) getInfoRecursive (ChildProperty _ _ i c) = i <> mconcat (map getInfoRecursive c) toProp = id + getSatisfy (ChildProperty _ 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 + modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f) -- toProp (RevertableProperty p1 _) = p1 -- | Return the Info of the currently active side. getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 toProp (RevertableProperty p1 _p2) = toProp p1 + getSatisfy (RevertableProperty p1 _) = getSatisfy p1 -- | Type level calculation of the type that results from combining two -- types of properties. |