From 6f032f7ee3ac43d4b77c78786c0951b49ce5b8e7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 2 Apr 2014 00:52:39 -0400
Subject: [PATCH] propellor spin

---
 Propellor/Property/Docker.hs | 54 ++++++++++++++++++++++++++++--------
 Propellor/Types.hs           |  4 +--
 config.hs                    |  6 ++--
 3 files changed, 47 insertions(+), 17 deletions(-)

diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 7189b98..d8b1027 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -44,15 +44,42 @@ docked
 	-> HostName
 	-> ContainerName
 	-> Property
-docked findcontainer hn cn = 
-	case findcontainer hn cn of
-		Nothing -> containerDesc cid $ Property "" $ do
-			warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
-			return FailedChange
-		Just (Container image containerprops) ->
-			provisionContainer cid
-				`requires`
-			runningContainer cid image containerprops
+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
+				]
+  where
+  	cid = ContainerId hn cn
+
+findContainer
+	:: (HostName -> ContainerName -> Maybe (Container))
+	-> HostName
+	-> ContainerName
+	-> (Container -> Property)
+	-> Property
+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
+	Just container -> mk container
   where
   	cid = ContainerId hn cn
 
@@ -72,9 +99,6 @@ garbageCollected = propertyList "docker garbage collected"
 		report <$> (mapM removeContainer =<< listContainers AllContainers)
 	gcimages = Property "docker images garbage collected" $ do
 		report <$> (mapM removeImage =<< listImages)
-	report rmed
-		| or rmed = MadeChange
-		| otherwise = NoChange
 
 -- | Pass to defaultMain to add docker containers.
 -- You need to provide the function mapping from
@@ -392,3 +416,9 @@ readIdentFile cid = fromMaybe (error "bad ident in identFile")
 
 dockercmd :: String
 dockercmd = "docker.io"
+
+report :: [Bool] -> Result
+report rmed
+	| or rmed = MadeChange
+	| otherwise = NoChange
+
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index bcb5efd..1be5674 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -48,10 +48,10 @@ class ActionResult a where
 
 instance ActionResult Bool where
 	getActionResult False = ("failed", Vivid, Red)
-	getActionResult True = ("ok", Dull, Green)
+	getActionResult True = ("done", Dull, Green)
 
 instance ActionResult Result where
-	getActionResult NoChange = ("unchanged", Dull, Green)
+	getActionResult NoChange = ("ok", Dull, Green)
 	getActionResult MadeChange = ("done", Vivid, Green)
 	getActionResult FailedChange = ("failed", Vivid, Red)
 
diff --git a/config.hs b/config.hs
index 6e938fc..b212fda 100644
--- a/config.hs
+++ b/config.hs
@@ -44,7 +44,7 @@ host hostname@"clam.kitenet.net" = Just
 	, File.dirExists "/var/www"
 	--, Docker.docked container hostname "webserver"
 	, Docker.garbageCollected
-	, Docker.docked container hostname "amd64-git-annex-builder"
+	, Docker.unDocked container hostname "amd64-git-annex-builder"
 	, Apt.installed ["git-annex", "mtr"]
 	-- Should come last as it reboots.
 	, Apt.installed ["systemd-sysv"] `onChange` Reboot.now
@@ -54,8 +54,8 @@ host hostname@"orca.kitenet.net" = Just
 	, standardSystem Unstable
 	, Apt.unattendedUpgrades True
 	, Docker.configured
-	, Docker.docked container hostname "amd64-git-annex-builder"
-	, Docker.docked container hostname "i386-git-annex-builder"
+	, Docker.unDocked container hostname "amd64-git-annex-builder"
+	, Docker.unDocked container hostname "i386-git-annex-builder"
 	, Docker.garbageCollected
 	]
 -- add more hosts here...