From 1d02d589c79781cc4b0bd82467edbdf64c40f34d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 8 Dec 2014 01:06:19 -0400 Subject: propellor spin --- src/Propellor/Property.hs | 6 ------ src/Propellor/Property/Cmd.hs | 6 +----- src/Propellor/Property/Docker.hs | 9 +++++---- src/Propellor/Property/Firewall.hs | 3 +-- src/Propellor/Types.hs | 8 ++++++++ 5 files changed, 15 insertions(+), 17 deletions(-) diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 6371cc09..37fd90d6 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -121,12 +121,6 @@ doNothing = property "noop property" noChange withOS :: Desc -> (Maybe System -> Propellor Result) -> Property withOS desc a = property desc $ a =<< getOS -boolProperty :: Desc -> IO Bool -> Property -boolProperty desc a = property desc $ ifM (liftIO a) - ( return MadeChange - , return FailedChange - ) - -- | Undoes the effect of a property. revert :: RevertableProperty -> RevertableProperty revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index 725f5757..d24b1a8a 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -13,7 +13,6 @@ import "mtl" Control.Monad.Reader import Propellor.Types import Propellor.Property -import Utility.Monad import Utility.SafeCommand import Utility.Env @@ -28,10 +27,7 @@ cmdProperty cmd params = cmdProperty' cmd params [] cmdProperty' :: String -> [String] -> [(String, String)] -> Property cmdProperty' cmd params env = property desc $ liftIO $ do env' <- addEntries env <$> getEnvironment - ifM (boolSystemEnv cmd (map Param params) (Just env')) - ( return MadeChange - , return FailedChange - ) + toResult <$> boolSystemEnv cmd (map Param params) (Just env') where desc = unwords $ cmd : params diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 5fa06517..5006ed9a 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -379,9 +379,10 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope createDirectoryIfMissing True (takeDirectory $ identFile cid) shim <- liftIO $ Shim.setup (localdir "propellor") Nothing (localdir shimdir cid) liftIO $ writeFile (identFile cid) (show ident) - ensureProperty $ boolProperty "run" $ runContainer img - (runps ++ ["-i", "-d", "-t"]) - [shim, "--continue", show (DockerInit (fromContainerId cid))] + ensureProperty $ property "run" $ liftIO $ + toResult <$> runContainer img + (runps ++ ["-i", "-d", "-t"]) + [shim, "--continue", show (DockerInit (fromContainerId cid))] -- | Called when propellor is running inside a docker container. -- The string should be the container's ContainerId. @@ -466,7 +467,7 @@ stoppedContainer :: ContainerId -> Property stoppedContainer cid = containerDesc cid $ property desc $ ifM (liftIO $ elem cid <$> listContainers RunningContainers) ( liftIO cleanup `after` ensureProperty - (boolProperty desc $ stopContainer cid) + (property desc $ liftIO $ toResult <$> stopContainer cid) , return NoChange ) where diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index b660207b..3018f989 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -33,8 +33,7 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable exist <- boolSystem "iptables" (chk args) if exist then return NoChange - else ifM (boolSystem "iptables" (add args)) - ( return MadeChange , return FailedChange) + else toResult <$> boolSystem "iptables" (add args) add params = (Param "-A") : params chk params = (Param "-C") : params diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 72e0e7ad..63abd226 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -14,6 +14,7 @@ module Propellor.Types , requires , Desc , Result(..) + , ToResult(..) , ActionResult(..) , CmdLine(..) , PrivDataField(..) @@ -131,6 +132,13 @@ instance Monoid Result where mappend _ MadeChange = MadeChange mappend NoChange NoChange = NoChange +class ToResult t where + toResult :: t -> Result + +instance ToResult Bool where + toResult False = FailedChange + toResult True = MadeChange + -- | Results of actions, with color. class ActionResult a where getActionResult :: a -> (String, ColorIntensity, Color) -- cgit v1.2.3