summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-06-16 14:53:08 -0400
committerJoey Hess2015-06-16 14:53:08 -0400
commitd353db60ad3a712d691832a67d40248b26a53e68 (patch)
tree7dce0ccf6bb88bd4147230a88b13cef365580144
parentb55ea3c29560bafced4b191393410177ba862327 (diff)
parent948f855c63d6f2da09ce3689d1b610b343501f73 (diff)
Merge branch 'joeyconfig'
-rw-r--r--config-joey.hs8
-rw-r--r--config-simple.hs2
-rw-r--r--debian/changelog8
-rw-r--r--src/Propellor/Property/Docker.hs79
4 files changed, 76 insertions, 21 deletions
diff --git a/config-joey.hs b/config-joey.hs
index f791ed38..8b53718a 100644
--- a/config-joey.hs
+++ b/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 Testing) arch) = "joeyh/debian-unstable-" ++ arch
-dockerImage (System (Debian (Stable _)) arch) = "joeyh/debian-stable-" ++ arch
-dockerImage _ = "debian-stable-official" -- does not currently exist!
+dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
+dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)
+dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch)
+dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist!
myDnsSecondary :: Property HasInfo
myDnsSecondary = propertyList "dns secondary for all my domains" $ props
diff --git a/config-simple.hs b/config-simple.hs
index 4f0fde8c..576ecc73 100644
--- a/config-simple.hs
+++ b/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"
diff --git a/debian/changelog b/debian/changelog
index 6e641881..079ecf48 100644
--- a/debian/changelog
+++ b/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,
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index d3e60fc2..05f25c31 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/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
- built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir
+ msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory
+ 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"
- pulled = Cmd.cmdProperty dockercmd ["pull", image]
+ msg = "docker image " ++ (imageIdentifier image) ++ " pulled"
+ 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.
-type Image = String
+-- | ImageID is an image identifier to perform action on images. An
+-- 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 = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
+listImages :: IO [ImageUID]
+listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
runProp :: String -> RunParam -> Property HasInfo
runProp field val = pureInfoProperty (param) $ dockerInfo $