From e9cac11ad3df54208b4a41d945ac9a333d21bb07 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 24 Oct 2015 15:17:40 -0400 Subject: Added Propellor.Property.Concurrent for concurrent properties. Note that no output multiplexing is currently done. --- debian/changelog | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 7271fef5..feddb128 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +propellor (2.12.1) UNRELEASED; urgency=medium + + * Added Propellor.Property.Concurrent for concurrent properties. + (Note that no output multiplexing is currently done.) + + -- Joey Hess Sat, 24 Oct 2015 15:16:45 -0400 + propellor (2.12.0) unstable; urgency=medium * The DiskImage module can now make bootable images using grub. -- cgit v1.3-2-g0d8e From 2410a8f1d6c850142181d724f4abd706a82b9593 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 24 Oct 2015 16:43:26 -0400 Subject: improve RevertableProperty combining * Various property combinators that combined a RevertableProperty with a non-revertable property used to yield a RevertableProperty. This was a bug, because the combined property could not be fully reverted in many cases. Fixed by making the combined property instead be a Property HasInfo. * combineWith now takes an addional parameter to control how revert actions are combined (API change). --- debian/changelog | 9 ++- propellor.cabal | 2 +- src/Propellor/Property.hs | 69 ++++++++++++-------- src/Propellor/Property/Concurrent.hs | 10 +-- src/Propellor/Property/Dns.hs | 2 +- src/Propellor/Property/DnsSec.hs | 4 +- src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 +- src/Propellor/Types.hs | 81 ++++++++++++------------ 8 files changed, 103 insertions(+), 76 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index feddb128..7155a2ac 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,14 @@ -propellor (2.12.1) UNRELEASED; urgency=medium +propellor (2.13.0) UNRELEASED; urgency=medium * Added Propellor.Property.Concurrent for concurrent properties. (Note that no output multiplexing is currently done.) + * Various property combinators that combined a RevertableProperty + with a non-revertable property used to yield a RevertableProperty. + This was a bug, because the combined property could not be fully + reverted in many cases. Fixed by making the combined property + instead be a Property HasInfo. + * combineWith now takes an additional parameter to control how revert + actions are combined (API change). -- Joey Hess Sat, 24 Oct 2015 15:16:45 -0400 diff --git a/propellor.cabal b/propellor.cabal index c672da3a..7a9d2b5d 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.12.0 +Version: 2.13.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 95805054..d80d9c1f 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -66,30 +66,43 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do -- | 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. requires :: Combines x y => x -> y -> CombinedType x y -requires = (<<>>) +requires = combineWith + -- Run action of y, then x + (flip (<>)) + -- When reverting, run in reverse order. + (<>) -- | 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. -before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x -before x y = (y `requires` x) `describe` getDesc x +before :: Combines x y => x -> y -> CombinedType x y +before = combineWith + -- Run action of x, then y + (<>) + -- When reverting, run in reverse order. + (flip (<>)) -- | Whenever a change has to be made for a Property, causes a hook -- Property to also be run, but not otherwise. onChange - :: (Combines (Property x) (Property y)) - => Property x - -> Property y - -> CombinedType (Property x) (Property y) -onChange = combineWith $ \p hook -> do - r <- p - case r of - MadeChange -> do - r' <- hook - return $ r <> r' - _ -> return r + :: (Combines x y) + => x + -> y + -> CombinedType x y +onChange = combineWith combiner revertcombiner + where + combiner p hook = do + r <- p + case r of + MadeChange -> do + r' <- hook + return $ r <> r' + _ -> return r + revertcombiner = (<>) -- | Same as `onChange` except that if property y fails, a flag file -- is generated. On next run, if the flag file is present, property y @@ -99,14 +112,14 @@ onChange = combineWith $ \p hook -> do -- `FailedChange`. But if this property is applied again, it returns -- `NoChange`. This behavior can cause trouble... onChangeFlagOnFail - :: (Combines (Property x) (Property y)) + :: (Combines x y) => FilePath - -> Property x - -> Property y - -> CombinedType (Property x) (Property y) -onChangeFlagOnFail flagfile = combineWith go + -> x + -> y + -> CombinedType x y +onChangeFlagOnFail flagfile = combineWith combiner revertcombiner where - go s1 s2 = do + combiner s1 s2 = do r1 <- s1 case r1 of MadeChange -> flagFailed s2 @@ -114,6 +127,7 @@ onChangeFlagOnFail flagfile = combineWith go (flagFailed s2 , return r1 ) + revertcombiner = (<>) flagFailed s = do r <- s liftIO $ case r of @@ -151,12 +165,15 @@ check c p = adjustPropertySatisfy p $ \satisfy -> -- | Tries the first property, but if it fails to work, instead uses -- the second. -fallback :: (Combines (Property p1) (Property p2)) => Property p1 -> Property p2 -> Property (CInfo p1 p2) -fallback = combineWith $ \a1 a2 -> do - r <- a1 - if r == FailedChange - then a2 - else return r +fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2 +fallback = combineWith combiner revertcombiner + where + combiner a1 a2 = do + r <- a1 + if r == FailedChange + then a2 + else return r + revertcombiner = (<>) -- | Marks a Property as trivial. It can only return FailedChange or -- NoChange. diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs index 95fd9fc5..c57f5228 100644 --- a/src/Propellor/Property/Concurrent.hs +++ b/src/Propellor/Property/Concurrent.hs @@ -21,11 +21,11 @@ import Control.Monad.RWS.Strict -- | Ensures two properties concurrently. concurrently - :: (IsProp (Property x), IsProp (Property y), Combines (Property x) (Property y), IsProp (Property (CInfo x y))) - => Property x - -> Property y - -> CombinedType (Property x) (Property y) -concurrently p1 p2 = (combineWith go p1 p2) + :: (IsProp p1, IsProp p2, Combines p1 p2, IsProp (CombinedType p1 p2)) + => p1 + -> p2 + -> CombinedType p1 p2 +concurrently p1 p2 = (combineWith go go p1 p2) `describe` d where d = getDesc p1 ++ " `concurrently` " ++ getDesc p2 diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 6646582b..4c2f787f 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -164,7 +164,7 @@ signedPrimary recurrance hosts domain soa rs = setup cleanup `onChange` Service.reloaded "bind9" cleanup = cleanupPrimary zonefile domain - `onChange` toProp (revert (zoneSigned domain zonefile)) + `onChange` revert (zoneSigned domain zonefile) `onChange` Service.reloaded "bind9" -- Include the public keys into the zone file. diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs index 7d1414d4..c0aa1302 100644 --- a/src/Propellor/Property/DnsSec.hs +++ b/src/Propellor/Property/DnsSec.hs @@ -41,11 +41,11 @@ zoneSigned :: Domain -> FilePath -> RevertableProperty zoneSigned domain zonefile = setup cleanup where setup = check needupdate (forceZoneSigned domain zonefile) - `requires` toProp (keysInstalled domain) + `requires` keysInstalled domain cleanup = File.notPresent (signedZoneFile zonefile) `before` File.notPresent dssetfile - `before` toProp (revert (keysInstalled domain)) + `before` revert (keysInstalled domain) dssetfile = dir "-" ++ domain ++ "." dir = takeDirectory zonefile diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 70d5884f..92903e9a 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -924,7 +924,7 @@ legacyWebSites = propertyList "legacy web sites" $ props userDirHtml :: Property HasInfo userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf `onChange` Apache.reloaded - `requires` (toProp $ Apache.modEnabled "userdir") + `requires` Apache.modEnabled "userdir" where munge = replace "public_html" "html" conf = "/etc/apache2/mods-available/userdir.conf" diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 5904374e..5f0e0561 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -27,7 +27,6 @@ module Propellor.Types , IsProp(..) , Combines(..) , CombinedType - , combineWith , Propellor(..) , LiftPropellor(..) , EndAction(..) @@ -160,6 +159,9 @@ propertySatisfy (SProperty _ a _) = a instance Show (Property i) where show p = "property " ++ show (propertyDesc p) +instance Show RevertableProperty where + show (RevertableProperty p _) = "property " ++ show (propertyDesc p) + -- | 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 @@ -221,57 +223,58 @@ instance IsProp RevertableProperty where -- types of properties. type family CombinedType x y type instance CombinedType (Property x) (Property y) = Property (CInfo x y) -type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty -type instance CombinedType RevertableProperty (Property HasInfo) = RevertableProperty type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty +-- When only one of the properties is revertable, the combined property is +-- not fully revertable, so is not a RevertableProperty. +type instance CombinedType RevertableProperty (Property NoInfo) = Property HasInfo +type instance CombinedType RevertableProperty (Property HasInfo) = Property HasInfo +type instance CombinedType (Property NoInfo) RevertableProperty = Property HasInfo +type instance CombinedType (Property HasInfo) RevertableProperty = Property HasInfo class Combines x y where - -- | Combines two properties. The second property is ensured - -- first, and only once it is successfully ensures will the first - -- be ensured. The combined property will have the description of - -- the first property. - (<<>>) :: x -> y -> CombinedType x y - --- | 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. The two actions to satisfy the properties --- are passed to a function that can combine them in arbitrary ways. -combineWith - :: (Combines (Property x) (Property y)) - => (Propellor Result -> Propellor Result -> Propellor Result) - -> Property x - -> Property y - -> CombinedType (Property x) (Property y) -combineWith f x y = adjustPropertySatisfy (x <<>> y) $ \_ -> - f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y) + -- | 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. + combineWith + :: (Propellor Result -> Propellor Result -> Propellor Result) + -- ^ How to combine the actions to satisfy the properties. + -> (Propellor Result -> Propellor Result -> Propellor Result) + -- ^ Used when combining revertable properties, to combine + -- their reversion actions. + -> x + -> y + -> CombinedType x y instance Combines (Property HasInfo) (Property HasInfo) where - (IProperty d1 a1 i1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) = - IProperty d1 (a2 <> a1) i1 (y : cs1) + 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 - (IProperty d1 a1 i1 cs1) <<>> y@(SProperty _d2 a2 _cs2) = - IProperty d1 (a2 <> a1) i1 (toIProperty y : cs1) + 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 - (SProperty d1 a1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) = - IProperty d1 (a2 <> a1) mempty (y : map toIProperty cs1) + 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 - (SProperty d1 a1 cs1) <<>> y@(SProperty _d2 a2 _cs2) = - SProperty d1 (a2 <> a1) (y : cs1) + combineWith f _ (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) = + SProperty d1 (f a1 a2) (y : cs1) + +instance Combines RevertableProperty RevertableProperty where + combineWith sf tf (RevertableProperty setup1 teardown1) (RevertableProperty setup2 teardown2) = + RevertableProperty + (combineWith sf tf setup1 setup2) + (combineWith tf sf teardown1 teardown2) instance Combines RevertableProperty (Property HasInfo) where - (RevertableProperty p1 p2) <<>> y = - RevertableProperty (p1 <<>> y) p2 + combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y instance Combines RevertableProperty (Property NoInfo) where - (RevertableProperty p1 p2) <<>> y = - RevertableProperty (p1 <<>> toIProperty y) p2 + combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance Combines RevertableProperty RevertableProperty where - (RevertableProperty x1 x2) <<>> (RevertableProperty y1 y2) = - RevertableProperty - (x1 <<>> y1) - -- when reverting, run actions in reverse order - (y2 <<>> x2) +instance Combines (Property HasInfo) RevertableProperty where + combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y + +instance Combines (Property NoInfo) RevertableProperty where + combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y -- cgit v1.3-2-g0d8e From 77e3a5d4d968f3567b1b8e62996e0e6c803ab642 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 26 Oct 2015 15:38:29 -0400 Subject: changelog --- debian/changelog | 1 + 1 file changed, 1 insertion(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 7155a2ac..ba94f6bf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,7 @@ propellor (2.13.0) UNRELEASED; urgency=medium instead be a Property HasInfo. * combineWith now takes an additional parameter to control how revert actions are combined (API change). + * Add File.isCopyOf. Thanks, Per Olofsson. -- Joey Hess Sat, 24 Oct 2015 15:16:45 -0400 -- cgit v1.3-2-g0d8e