From 765367dab9b61a512e07268c921f950677af4f27 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 1 Jun 2015 23:16:25 -0400
Subject: [PATCH] add Bound

---
 propellor.cabal                   |  1 +
 src/Propellor/Property/Systemd.hs | 44 ++++++++++++++++---------------
 src/Propellor/Types/Container.hs  | 30 +++++++++++++++++++++
 3 files changed, 54 insertions(+), 21 deletions(-)
 create mode 100644 src/Propellor/Types/Container.hs

diff --git a/propellor.cabal b/propellor.cabal
index 16dffe3..9edc143 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -121,6 +121,7 @@ Library
     Propellor.Exception
     Propellor.Types
     Propellor.Types.Chroot
+    Propellor.Types.Container
     Propellor.Types.Docker
     Propellor.Types.Dns
     Propellor.Types.Empty
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 055c02e..1d03d55 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 module Propellor.Property.Systemd (
 	-- * Services
 	module Propellor.Property.Systemd.Core,
@@ -24,17 +26,18 @@ module Propellor.Property.Systemd (
 	resolvConfed,
 	linkJournal,
 	privateNetwork,
-	ForwardedPort(..),
+	module Propellor.Types.Container,
 	Proto(..),
-	PortSpec(..),
 	Publishable,
 	publish,
+	Bindable,
 	bind,
 	bindRo,
 ) where
 
 import Propellor
 import Propellor.Types.Chroot
+import Propellor.Types.Container
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.File as File
@@ -308,21 +311,14 @@ class Publishable a where
 instance Publishable Port where
 	toPublish (Port n) = show n
 
-data ForwardedPort = ForwardedPort
-	{ hostPort :: Port
-	, containerPort :: Port
-	}
-
-instance Publishable ForwardedPort where
-	toPublish fp = toPublish (hostPort fp) ++ ":" ++ toPublish (containerPort fp)
+instance Publishable (Bound Port) where
+	toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
 
 data Proto = TCP | UDP
 
-data PortSpec = PortSpec Proto ForwardedPort
-
-instance Publishable PortSpec where
-	toPublish (PortSpec TCP fp) = "tcp:" ++ toPublish fp
-	toPublish (PortSpec UDP fp) = "udp:" ++ toPublish fp
+instance Publishable (Proto, Bound Port) where
+	toPublish (TCP, fp) = "tcp:" ++ toPublish fp
+	toPublish (UDP, fp) = "udp:" ++ toPublish fp
 
 -- | Publish a port from the container on the host.
 --
@@ -334,13 +330,19 @@ instance Publishable PortSpec where
 publish :: Publishable p => p -> RevertableProperty
 publish p = containerCfg $ "--port=" ++ toPublish p
 
+class Bindable a where
+	toBind :: a -> String
+
+instance Bindable FilePath where
+	toBind f = f
+
+instance Bindable (Bound FilePath) where
+	toBind v = hostSide v ++ ":" ++ containerSide v
+
 -- | Bind mount a file or directory from the host into the container.
---
--- The parameter can be a FilePath, or a colon-separated pair of
--- hostpath:containerpath.
-bind :: FilePath -> RevertableProperty
-bind f = containerCfg $ "--bind=" ++ f
+bind :: Bindable p => p -> RevertableProperty
+bind p = containerCfg $ "--bind=" ++ toBind p
 
 -- | Read-only mind mount.
-bindRo :: FilePath -> RevertableProperty
-bindRo f = containerCfg $ "--bind-ro=" ++ f
+bindRo :: Bindable p => p -> RevertableProperty
+bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs
new file mode 100644
index 0000000..d21bada
--- /dev/null
+++ b/src/Propellor/Types/Container.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Propellor.Types.Container where
+
+-- | A value that can be bound between the host and a container.
+--
+-- For example, a Bound Port is a Port on the container that is bound to
+-- a Port on the host.
+data Bound v = Bound
+	{ hostSide :: v
+	, containerSide :: v
+	}
+
+-- | Create a Bound value, from two different values for the host and
+-- container.
+--
+-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host
+-- is bound to port 80 from the container.
+(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v
+(-<-) hostv containerv = Bound hostv containerv
+
+-- | Flipped version of -<- with the container value first and host value
+-- second.
+(->-) :: (containerv ~ v, hostv ~ v) => hostv -> containerv -> Bound v
+(->-) containerv hostv = Bound hostv containerv
+
+-- | Create a Bound value, that is the same on both the host and container.
+same :: v -> Bound v
+same v = Bound v v
+