From bd5c0c1f520b1a050195ae7a5c7f536147906d17 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 8 Apr 2014 01:10:54 -0400
Subject: [PATCH] adding support for linked containers

---
 Propellor/Property/Docker.hs | 29 ++++++++++++++++++++++-------
 1 file changed, 22 insertions(+), 7 deletions(-)

diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 784b113..255b72a 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -116,7 +116,7 @@ containerProperties findcontainer = \h -> case toContainerId h of
 -- container.
 data Container = Container Image [Containerized Property]
 
-data Containerized a = Containerized [RunParam] a
+data Containerized a = Containerized [HostName -> RunParam] a
 
 -- | Parameters to pass to `docker run` when creating a container.
 type RunParam = String
@@ -170,6 +170,15 @@ workdir = runProp "workdir"
 memory :: String -> Containerized Property
 memory = runProp "memory"
 
+-- | Link with another container on the same host.
+link :: ContainerName -> ContainerAlias -> Containerized Property
+link linkwith alias = genProp "link" $ \hn ->
+	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
+
+-- | A short alias for a linked container.
+-- Each container has its own alias namespace.
+type ContainerAlias = String
+
 -- | A container is identified by its name, and the host
 -- on which it's deployed.
 data ContainerId = ContainerId HostName ContainerName
@@ -181,10 +190,10 @@ data ContainerId = ContainerId HostName ContainerName
 data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
 	deriving (Read, Show, Eq)
 
-getRunParams :: [Containerized a] -> [RunParam]
-getRunParams l = concatMap get l
+getRunParams :: HostName -> [Containerized a] -> [RunParam]
+getRunParams hn l = concatMap get l
   where
-	get (Containerized ps _) = ps
+	get (Containerized ps _) = map (\a -> a hn ) ps
 
 fromContainerized :: forall a. [Containerized a] -> [a]
 fromContainerized l = map get l
@@ -243,7 +252,7 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
 		simpleShClient (namedPipe cid) "cat" [propellorIdent] $
 			pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout
 
-	runps = getRunParams $ containerprops ++
+	runps = getRunParams hn $ containerprops ++
 		-- expose propellor directory inside the container
 		[ volume (localdir++":"++localdir)
 		-- name the container in a predictable way so we
@@ -386,11 +395,17 @@ listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Containerized Property
-runProp field val = 
-	Containerized ["--" ++ param] (Property (param) (return NoChange))
+runProp field val = Containerized
+	[\_ -> "--" ++ param]
+	(Property (param) (return NoChange))
   where
 	param = field++"="++val
 
+genProp :: String -> (HostName -> RunParam) -> Containerized Property
+genProp field mkval = Containerized
+	[\h -> "--" ++ field ++ "=" ++ mkval h]
+	(Property field (return NoChange))
+
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
 -- the container has the same ident later.