Merge branch 'joeyconfig'

config-joey.hs

@@ -505,10 +505,10 @@ standardDockerContainer name suite arch = Docker.container name (dockerImage sys
 
 -- Docker images I prefer to use.
 dockerImage :: System -> Docker.Image
-dockerImage (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
+dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
-dockerImage (System (Debian Testing) arch) = "joeyh/debian-unstable-" ++ arch
+dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
-dockerImage (System (Debian (Stable _)) arch) = "joeyh/debian-stable-" ++ arch
+dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch)
-dockerImage _ = "debian-stable-official" -- does not currently exist!
+dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist!
 
 myDnsSecondary :: Property HasInfo
 myDnsSecondary = propertyList "dns secondary for all my domains" $ props

config-simple.hs

@@ -41,7 +41,7 @@ hosts =
 
 -- A generic webserver in a Docker container.
 webserverContainer :: Docker.Container
-webserverContainer = Docker.container "webserver" "debian"
+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
 	& os (System (Debian (Stable "jessie")) "amd64")
 	& Apt.stdSourcesList
 	& Docker.publish "80:80"

debian/changelog

@@ -1,3 +1,11 @@
+propellor (2.6.0) UNRELEASED; urgency=medium
+
+  * Replace String type synonym Docker.Image by a data type
+    which allows to specify an image name and an optional tag. (API change)
+    Thanks, Antoine Eiche.
+
+ -- Joey Hess <id@joeyh.name>  Tue, 16 Jun 2015 14:49:12 -0400
+
 propellor (2.5.0) unstable; urgency=medium
 
   * cmdProperty' renamed to cmdPropertyEnv to make way for a new,

src/Propellor/Property/Docker.hs

@@ -16,7 +16,8 @@ module Propellor.Property.Docker (
 	memoryLimited,
 	garbageCollected,
 	tweaked,
-	Image,
+	Image(..),
+	latestImage,
 	ContainerName,
 	Container,
 	HasImage(..),
@@ -155,8 +156,8 @@ docked ctr@(Container _ h) =
 imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo
 imageBuilt directory ctr = describe built msg
   where
-	msg = "docker image " ++ image ++ " built from " ++ directory
+	msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory
-	built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir
+	built = Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
 	workDir p = p { cwd = Just directory }
 	image = getImageName ctr
 
@@ -164,8 +165,8 @@ imageBuilt directory ctr = describe built msg
 imagePulled :: HasImage c => c -> Property NoInfo
 imagePulled ctr = describe pulled msg
   where
-	msg = "docker image " ++ image ++ " pulled"
+	msg = "docker image " ++ (imageIdentifier image) ++ " pulled"
-	pulled = Cmd.cmdProperty dockercmd ["pull", image]
+	pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
 	image = getImageName ctr
 
 propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
@@ -243,8 +244,52 @@ data ContainerInfo = ContainerInfo Image [RunParam]
 -- | Parameters to pass to `docker run` when creating a container.
 type RunParam = String
 
--- | A docker image, that can be used to run a container.
+-- | ImageID is an image identifier to perform action on images. An
-type Image = String
+-- ImageID can be the name of an container image, a UID, etc.
+--
+-- It just encapsulates a String to avoid the definition of a String
+-- instance of ImageIdentifier.
+newtype ImageID = ImageID String
+
+-- | Used to perform Docker action on an image.
+--
+-- Minimal complete definition: `imageIdentifier`
+class ImageIdentifier i where
+	-- | For internal purposes only.
+	toImageID :: i -> ImageID
+	toImageID = ImageID . imageIdentifier
+	-- | A string that Docker can use as an image identifier.
+	imageIdentifier :: i -> String
+
+instance ImageIdentifier ImageID where
+	imageIdentifier (ImageID i) = i
+	toImageID = id
+
+-- | A docker image, that can be used to run a container. The user has
+-- to specify a name and can provide an optional tag.
+-- See <http://docs.docker.com/userguide/dockerimages/ Docker Image Documention>
+-- for more information.
+data Image = Image
+	{ repository :: String
+	, tag :: Maybe String
+	}
+	deriving (Eq, Read, Show)
+
+-- | Defines a Docker image without any tag. This is considered by
+-- Docker as the latest image of the provided repository.
+latestImage :: String -> Image
+latestImage repo = Image repo Nothing
+
+instance ImageIdentifier Image where
+	-- | The format of the imageIdentifier of an `Image` is:
+	-- repository | repository:tag
+	imageIdentifier i = repository i ++ (maybe "" ((++) ":") $ tag i)
+
+-- | The UID of an image. This UID is generated by Docker.
+newtype ImageUID = ImageUID String
+
+instance ImageIdentifier ImageUID where
+	imageIdentifier (ImageUID uid) = uid
 
 -- | Set custom dns server for container.
 dns :: String -> Property HasInfo
@@ -424,7 +469,9 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 		return FailedChange
 
 	restartcontainer = do
-		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+		oldimage <- liftIO $
+			fromMaybe (toImageID image) . fmap toImageID <$>
+				commitContainer cid
 		void $ liftIO $ removeContainer cid
 		go oldimage
 
@@ -561,20 +608,20 @@ removeContainer :: ContainerId -> IO Bool
 removeContainer cid = catchBoolIO $
 	snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
 
-removeImage :: Image -> IO Bool
+removeImage :: ImageIdentifier i => i -> IO Bool
 removeImage image = catchBoolIO $
-	snd <$> processTranscript dockercmd ["rmi", image ] Nothing
+	snd <$> processTranscript dockercmd ["rmi", imageIdentifier image] Nothing
 
-runContainer :: Image -> [RunParam] -> [String] -> IO Bool
+runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool
 runContainer image ps cmd = boolSystem dockercmd $ map Param $
-	"run" : (ps ++ image : cmd)
+	"run" : (ps ++ (imageIdentifier image) : cmd)
 
 inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
 inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd)
 
-commitContainer :: ContainerId -> IO (Maybe Image)
+commitContainer :: ContainerId -> IO (Maybe ImageUID)
 commitContainer cid = catchMaybeIO $
-	takeWhile (/= '\n') 
+	ImageUID . takeWhile (/= '\n')
 		<$> readProcess dockercmd ["commit", fromContainerId cid]
 
 data ContainerFilter = RunningContainers | AllContainers
@@ -592,8 +639,8 @@ listContainers status =
 		| otherwise = baseps
 	baseps = ["ps", "--no-trunc"]
 
-listImages :: IO [Image]
+listImages :: IO [ImageUID]
-listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
+listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Property HasInfo
 runProp field val = pureInfoProperty (param) $ dockerInfo $