From 526bcbf093af665f316a0ba4d1a836786ab66dcf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 2 Apr 2014 12:13:39 -0400 Subject: type-safe reversions --- Propellor/Property/Apt.hs | 20 ++++++++++--------- Propellor/Property/Docker.hs | 47 ++++++++++++++++++++------------------------ 2 files changed, 32 insertions(+), 35 deletions(-) (limited to 'Propellor/Property') diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs index 92e23b7e..0b8b8ab9 100644 --- a/Propellor/Property/Apt.hs +++ b/Propellor/Property/Apt.hs @@ -129,16 +129,18 @@ autoRemove :: Property autoRemove = runApt ["-y", "autoremove"] `describe` "apt autoremove" -unattendedUpgrades :: Bool -> Property -unattendedUpgrades enabled = - (if enabled then installed else removed) ["unattended-upgrades"] - `onChange` reConfigure "unattended-upgrades" - [("unattended-upgrades/enable_auto_updates" , "boolean", v)] - `describe` ("unattended upgrades " ++ v) +-- | Enables unattended upgrades. Revert to disable. +unattendedUpgrades :: RevertableProperty +unattendedUpgrades = RevertableProperty (go True) (go False) where - v - | enabled = "true" - | otherwise = "false" + go enabled = (if enabled then installed else removed) ["unattended-upgrades"] + `onChange` reConfigure "unattended-upgrades" + [("unattended-upgrades/enable_auto_updates" , "boolean", v)] + `describe` ("unattended upgrades " ++ v) + where + v + | enabled = "true" + | otherwise = "false" -- | Preseeds debconf values and reconfigures the package so it takes -- effect. diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index d8b1027c..3f90d157 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -39,33 +39,27 @@ installed = Apt.installed ["docker.io"] -- | Ensures that a docker container is set up and running. The container -- has its own Properties which are handled by running propellor -- inside the container. +-- +-- Reverting this property ensures that the container is stopped and +-- removed. docked :: (HostName -> ContainerName -> Maybe (Container)) -> HostName -> ContainerName - -> Property + -> RevertableProperty docked findc hn cn = findContainer findc hn cn $ \(Container image containerprops) -> - provisionContainer cid - `requires` - runningContainer cid image containerprops - where - cid = ContainerId hn cn - --- | Ensures that a docker container is no longer running. -unDocked - :: (HostName -> ContainerName -> Maybe (Container)) - -> HostName - -> ContainerName - -> Property -unDocked findc hn cn = findContainer findc hn cn $ - \(Container image _containerprops) -> - Property ("undocked " ++ fromContainerId cid) $ - report <$> mapM id - [ stopContainer cid - , removeContainer cid - , removeImage image - ] + let setup = provisionContainer cid + `requires` + runningContainer cid image containerprops + teardown = + Property ("undocked " ++ fromContainerId cid) $ + report <$> mapM id + [ stopContainer cid + , removeContainer cid + , removeImage image + ] + in RevertableProperty setup teardown where cid = ContainerId hn cn @@ -73,15 +67,16 @@ findContainer :: (HostName -> ContainerName -> Maybe (Container)) -> HostName -> ContainerName - -> (Container -> Property) - -> Property + -> (Container -> RevertableProperty) + -> RevertableProperty findContainer findc hn cn mk = case findc hn cn of - Nothing -> containerDesc (ContainerId hn cn) $ Property "" $ do - warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid - return FailedChange + Nothing -> RevertableProperty cantfind cantfind Just container -> mk container where cid = ContainerId hn cn + cantfind = containerDesc (ContainerId hn cn) $ Property "" $ do + warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid + return FailedChange -- | Causes *any* docker images that are not in use by running containers to -- be deleted. And deletes any containers that propellor has set up -- cgit v1.2.3