summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-02 12:13:39 -0400
committerJoey Hess2014-04-02 13:18:08 -0400
commit526bcbf093af665f316a0ba4d1a836786ab66dcf (patch)
treed4ceb9ec125587cfac37cb50c178fcc4624dcedf /Propellor/Property
parent7705f65ae22f38989f404c77de4d661b652e692e (diff)
type-safe reversions
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Apt.hs20
-rw-r--r--Propellor/Property/Docker.hs47
2 files changed, 32 insertions, 35 deletions
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