From b816e40e2618a8932144bceb7c7039adc5c44c11 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 5 Dec 2015 15:48:03 -0400 Subject: Added UncheckedProperty type, along with unchecked to indicate a Property needs its result checked, and checkResult and changesFile to check for changes. --- debian/changelog | 4 +- doc/todo/type-level_trivial_avoidance.mdwn | 92 ++++++++++++++++++++++++++++++ propellor.cabal | 1 + src/Propellor/Property.hs | 22 +++---- src/Propellor/Property/Apt.hs | 3 +- src/Propellor/Types/ResultCheck.hs | 53 +++++++++++++++++ 6 files changed, 163 insertions(+), 12 deletions(-) create mode 100644 doc/todo/type-level_trivial_avoidance.mdwn create mode 100644 src/Propellor/Types/ResultCheck.hs diff --git a/debian/changelog b/debian/changelog index e7afe17d..2290ccc5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,8 +5,10 @@ propellor (2.14.1) UNRELEASED; urgency=medium * Added Postfix.saslPasswdSet. * Added Propellor.Property.Locale. Thanks, Sean Whitton. - * Added changesFile property combinator. * Added Propellor.Property.Fail2Ban. + * Added UncheckedProperty type, along with unchecked to indicate a + Property needs its result checked, and checkResult and changesFile + to check for changes. -- Joey Hess Tue, 24 Nov 2015 17:06:12 -0400 diff --git a/doc/todo/type-level_trivial_avoidance.mdwn b/doc/todo/type-level_trivial_avoidance.mdwn new file mode 100644 index 00000000..797a1f8e --- /dev/null +++ b/doc/todo/type-level_trivial_avoidance.mdwn @@ -0,0 +1,92 @@ +The `trivial` property combinator is a bit of a code smell. It's almost +always better for a property to do the work to return MadeChange +accurately. While it doesn't matter if a property directly attached to a +Host is trivial, it can matter a great deal when eg, a disk image needs to +be regenerated when a property makes a change to the source chroot. + +So, I'd like to move propellor to having all properties return an accurate +MadeChange. Of course, it's up to the implementation to get that right, but +avoiding `trivial` would go a long way. + +At the same time, it's sometimes useful to use trivial along the way to a +non-trivial property. + + trivial (cmdProperty "apt-get" ["-y", "install", "foo"]) + `changesFile` "/var/lib/dpkg/status" + +Here the cmdProperty normally returns MadeChange, so trivial is used to +throw that innaccurate value away and the changesFile combinator checks for +changes. + +(The alternative would be for cmdProperty to normally return NoChange, and +then have changesFile cause MadeChange to be returned. However, this +approach has plenty of foot-shooting potential of its own, for example +using cmdProperty and forgetting to check if it made any changes. If +trivial is a code smell, making cmdProperty and similar generic property +building tools trivial by default is surely not good..) + +---- + +## So, could this be fixed at the type level? + +---- + +### UncheckedProperty as an alternative to Property + +Perhaps it would make sense to +have a UncheckedProperty, which could be used for things like +`cmdProperty`. Combinators like `changesFile` would convert it to a +Property. + +(A `trivial` combinator could still be written of course, but it wouldn't be +necessary in cases like the above example anymore, so it would be more +clearly a code smell to use `trivial`.) + +If UncheckedProperty was added, we'd want all the usual property +combinators to also work with it. Including `requires`. This is entirely +doable, but it's going to need quite a lot of duplicated code. + +For instance, there are 4 instances currently to handle combining properties +with and without info; here's one of them: + + 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) + +Adding UncheckedProperty to the mix, we need another 4 instances for combining +two of those. Plus 4 more for Property + UncheckedProperty = UncheckedProperty. +Plus 4 more for combining UncheckedProperty + Property! Each of those instances +has to be implemented separately. The code duplication doesn't stop at +instances; also need constructors for UncheckedProperty, etc. + +### extending Property + +Another approach would be `Property i Unchecked|Checked`. But that seems +overcomplicating for the end user, since most properties that users will +deal with are not checked. + +### minimal UncheckedProperty + +Maybe add UncheckedProperty, but without the combining instances? + +How about this simple interface: + + unchecked :: Property i -> UncheckedProperty i + + checkResult :: ResultCheckable p => IO a -> (a -> IO Result) -> p i -> Property i + + -- Both Property and UncheckedProperty are ResultCheckable. + + changesFile :: Checkable p => p i -> FilePath -> Property i + changesFile p f = checkWith getstat comparestat p + where + getstat = ... + comparestat old = do + new <- getstat + return $ if old == new then MadeChange else NoChange + +Then, cmdProperty would construct a regular property, but apply `unchecked` +to it. Users of `cmdProperty` would need to apply changesFile or a similar +check to it before combining it with any other properties. + +> Yes, let's go this way. [[done]] --[[Joey]] diff --git a/propellor.cabal b/propellor.cabal index 6ddc6c9d..b59e35dd 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -143,6 +143,7 @@ Library Propellor.Types.OS Propellor.Types.PrivData Propellor.Types.Result + Propellor.Types.ResultCheck Propellor.Types.CmdLine Other-Modules: Propellor.Bootstrap diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 063e7814..f57fcaee 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -12,7 +12,6 @@ module Propellor.Property ( , check , fallback , trivial - , changesFile , revert -- * Property descriptions , describe @@ -26,6 +25,12 @@ module Propellor.Property ( , noChange , doNothing , endAction + -- * Property result checking + , UncheckedProperty + , unchecked + , changesFile + , checkResult + , Checkable ) where import System.Directory @@ -37,6 +42,7 @@ import "mtl" Control.Monad.RWS.Strict import System.Posix.Files import Propellor.Types +import Propellor.Types.ResultCheck import Propellor.Info import Propellor.Exception import Utility.Exception @@ -193,17 +199,13 @@ trivial p = adjustPropertySatisfy p $ \satisfy -> do -- | Indicates that a Property may change a particular file. When the file -- is modified, the property will return MadeChange instead of NoChange. -changesFile :: Property i -> FilePath -> Property i -changesFile p f = adjustPropertySatisfy p $ \satisfy -> do - s <- getstat - r <- satisfy - if r == NoChange - then do - s' <- getstat - return (if samestat s s' then NoChange else MadeChange) - else return r +changesFile :: Checkable p i => p i -> FilePath -> Property i +changesFile p f = checkResult getstat comparestat p where getstat = liftIO $ catchMaybeIO $ getSymbolicLinkStatus f + comparestat oldstat = do + newstat <- getstat + return $ if samestat oldstat newstat then NoChange else MadeChange samestat Nothing Nothing = True samestat (Just a) (Just b) = and -- everything except for atime diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index fd6230e8..83ad2cda 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -159,7 +159,8 @@ removed ps = check (or <$> isInstalled' ps) go go = runApt $ ["-y", "remove"] ++ ps buildDep :: [Package] -> Property NoInfo -buildDep ps = robustly go +buildDep ps = trivial (robustly go) + `changesFile` "/var/lib/dpkg/status" `describe` (unwords $ "apt build-dep":ps) where go = runApt $ ["-y", "build-dep"] ++ ps diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs new file mode 100644 index 00000000..6c2e1453 --- /dev/null +++ b/src/Propellor/Types/ResultCheck.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +module Propellor.Types.ResultCheck ( + UncheckedProperty, + unchecked, + checkResult, + Checkable, +) where + +import Propellor.Types +import Propellor.Exception + +import Data.Monoid +import Control.Monad.IO.Class (liftIO) + +-- | This is a `Property` but its `Result` is not accurate; in particular +-- it may return `NoChange` despite having made a change. However, when it +-- returns `MadeChange`, it really did made a change, and `FailedChange` +-- is still an error. +data UncheckedProperty i = UncheckedProperty (Property i) + +-- | Use to indicate that a Property is unchecked. +unchecked :: Property i -> UncheckedProperty i +unchecked = UncheckedProperty + +-- | Checks the result of a property. Mostly used to convert a +-- `UncheckedProperty` to a `Property`, but can also be used to further +-- check a `Property`. +checkResult + :: Checkable p i + => IO a + -- ^ Run before ensuring the property. + -> (a -> IO Result) + -- ^ Run after ensuring the property. Return `MadeChange` if a + -- change was detected, or `NoChange` if no change was detected. + -> p i + -> Property i +checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do + a <- liftIO precheck + r <- catchPropellor satisfy + -- Always run postcheck, even if the result is already MadeChange, + -- as it may need to clean up after precheck. + r' <- liftIO $ postcheck a + return (r <> r') + +class Checkable p i where + checkedProp :: p i -> Property i + +instance Checkable Property i where + checkedProp = id + +instance Checkable UncheckedProperty i where + checkedProp (UncheckedProperty p) = p -- cgit v1.2.3