summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-06-01 23:16:25 -0400
committerJoey Hess2015-06-01 23:16:25 -0400
commit765367dab9b61a512e07268c921f950677af4f27 (patch)
treee721bcd464c0b9dbe619304b6995c40e1dfeb2f6 /src/Propellor
parent6241a16772649d3b918085ec4f113665fcf53459 (diff)
add Bound
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/Systemd.hs44
-rw-r--r--src/Propellor/Types/Container.hs30
2 files changed, 53 insertions, 21 deletions
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 055c02ed..1d03d557 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 00000000..d21bada7
--- /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
+