add Bound
This commit is contained in:
parent
6241a16772
commit
765367dab9
|
@ -121,6 +121,7 @@ Library
|
|||
Propellor.Exception
|
||||
Propellor.Types
|
||||
Propellor.Types.Chroot
|
||||
Propellor.Types.Container
|
||||
Propellor.Types.Docker
|
||||
Propellor.Types.Dns
|
||||
Propellor.Types.Empty
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
Loading…
Reference in New Issue