    {-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}

    -- | Maintainer: currently unmaintained; your name here!
    --
    -- Docker support for propellor
    --
    -- The existance of a docker container is just another Property of a system,
    -- which propellor can set up. See config.hs for an example.

    module Propellor.Property.Docker (
    	-- * Host properties
    	installed,
    	configured,
    	container,
    	docked,
    	imageBuilt,
    	imagePulled,
    	memoryLimited,
    	garbageCollected,
    	tweaked,
    	Image(..),
    	latestImage,
    	ContainerName,
    	Container(..),
    	HasImage(..),
    	-- * Container configuration
    	dns,
    	hostname,
    	Publishable,
    	publish,
    	expose,
    	user,
    	Mountable,
    	volume,
    	volumes_from,
    	workdir,
    	memory,
    	cpuShares,
    	link,
    	environment,
    	ContainerAlias,
    	restartAlways,
    	restartOnFailure,
    	restartNever,
    	-- * Internal use
    	init,
    	chain,
    ) where

    import Propellor.Base hiding (init)
    import Propellor.Types.Docker
    import Propellor.Types.Container
    import Propellor.Types.Core
    import Propellor.Types.CmdLine
    import Propellor.Types.Info
    import Propellor.Container
    import qualified Propellor.Property.File as File
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.Cmd as Cmd
    import qualified Propellor.Property.Pacman as Pacman
    import qualified Propellor.Shim as Shim
    import Utility.Path
    import Utility.ThreadScheduler
    import Utility.Split

    import Control.Concurrent.Async hiding (link)
    import System.Posix.Directory
    import System.Posix.Process
    import Prelude hiding (init)
    import Data.List hiding (init)
    import qualified Data.Map as M
    import System.Console.Concurrent

    installed :: Property (DebianLike + ArchLinux)
    installed :: Property (DebianLike + ArchLinux)
    installed = [ContainerName] -> Property DebianLike
    Apt.installed [ContainerName
    "docker.io"] Property DebianLike -> Property ArchLinux -> Property Linux
    forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
    (HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
     DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
     SingI c) =>
    Property (MetaTypes a)
    -> Property (MetaTypes b) -> Property (MetaTypes c)
    `pickOS` [ContainerName] -> Property ArchLinux
    Pacman.installed [ContainerName
    "docker"]

    -- | Configures docker with an authentication file, so that images can be
    -- pushed to index.docker.io. Optional.
    configured :: Property (HasInfo + DebianLike)
    configured :: Property (HasInfo + DebianLike)
    configured = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    Property (HasInfo + DebianLike)
    prop Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property Linux
    -> CombinedType
         (Property
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
         (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property Linux
    Property (DebianLike + ArchLinux)
    installed
      where
    	prop :: Property (HasInfo + DebianLike)
    	prop :: Property (HasInfo + DebianLike)
    prop = PrivDataSource
    -> Context
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property (HasInfo + DebianLike))
    -> Property (HasInfo + DebianLike)
    forall c s metatypes.
    (IsContext c, IsPrivDataSource s,
     IncludesInfo metatypes ~ 'True) =>
    s
    -> c
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property metatypes)
    -> Property metatypes
    withPrivData PrivDataSource
    src Context
    anyContext ((((PrivData -> Propellor Result) -> Propellor Result)
      -> Property (HasInfo + DebianLike))
     -> Property (HasInfo + DebianLike))
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property (HasInfo + DebianLike))
    -> Property (HasInfo + DebianLike)
    forall a b. (a -> b) -> a -> b
    $ \(PrivData -> Propellor Result) -> Propellor Result
    getcfg ->
    		ContainerName
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' ContainerName
    "docker configured" ((OuterMetaTypesWitness
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> (PrivData -> Propellor Result) -> Propellor Result
    getcfg ((PrivData -> Propellor Result) -> Propellor Result)
    -> (PrivData -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \PrivData
    cfg -> OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property UnixLike -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property UnixLike -> Propellor Result)
    -> Property UnixLike -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    			ContainerName
    "/root/.dockercfg" ContainerName -> [ContainerName] -> Property UnixLike
    `File.hasContent` PrivData -> [ContainerName]
    privDataLines PrivData
    cfg
    	src :: PrivDataSource
    src = PrivDataField -> ContainerName -> ContainerName -> PrivDataSource
    PrivDataSourceFileFromCommand PrivDataField
    DockerAuthentication
    		ContainerName
    "/root/.dockercfg" ContainerName
    "docker login"

    -- | A short descriptive name for a container.
    -- Should not contain whitespace or other unusual characters,
    -- only [a-zA-Z0-9_-] are allowed
    type ContainerName = String

    -- | A docker container.
    data Container = Container Image Host

    instance IsContainer Container where
    	containerProperties :: Container -> [ChildProperty]
    containerProperties (Container Image
    _ Host
    h) = Host -> [ChildProperty]
    forall c. IsContainer c => c -> [ChildProperty]
    containerProperties Host
    h
    	containerInfo :: Container -> Info
    containerInfo (Container Image
    _ Host
    h) = Host -> Info
    forall c. IsContainer c => c -> Info
    containerInfo Host
    h
    	setContainerProperties :: Container -> [ChildProperty] -> Container
    setContainerProperties (Container Image
    i Host
    h) [ChildProperty]
    ps = Image -> Host -> Container
    Container Image
    i (Host -> [ChildProperty] -> Host
    forall c. IsContainer c => c -> [ChildProperty] -> c
    setContainerProperties Host
    h [ChildProperty]
    ps)

    class HasImage a where
    	getImageName :: a -> Image

    instance HasImage Image where
    	getImageName :: Image -> Image
    getImageName = Image -> Image
    forall a. a -> a
    id

    instance HasImage Container where
    	getImageName :: Container -> Image
    getImageName (Container Image
    i Host
    _) = Image
    i

    -- | Defines a Container with a given name, image, and properties.
    -- Add properties to configure the Container.
    --
    -- > container "web-server" (latestImage "debian") $ props
    -- >    & publish "80:80"
    -- >    & Apt.installed {"apache2"]
    -- >    & ...
    container :: ContainerName -> Image -> Props metatypes -> Container
    container :: forall metatypes.
    ContainerName -> Image -> Props metatypes -> Container
    container ContainerName
    cn Image
    image (Props [ChildProperty]
    ps) = Image -> Host -> Container
    Container Image
    image (ContainerName -> [ChildProperty] -> Info -> Host
    Host ContainerName
    cn [ChildProperty]
    ps Info
    info)
      where
    	info :: Info
    info = DockerInfo -> Info
    dockerInfo DockerInfo
    forall a. Monoid a => a
    mempty Info -> Info -> Info
    forall a. Semigroup a => a -> a -> a
    <> [Info] -> Info
    forall a. Monoid a => [a] -> a
    mconcat ((ChildProperty -> Info) -> [ChildProperty] -> [Info]
    forall a b. (a -> b) -> [a] -> [b]
    map ChildProperty -> Info
    forall p. IsProp p => p -> Info
    getInfoRecursive [ChildProperty]
    ps)

    -- | Ensures that a docker container is set up and running.
    --
    -- The container has its own Properties which are handled by running
    -- propellor inside the container.
    --
    -- When the container's Properties include DNS info, such as a CNAME,
    -- that is propagated to the Info of the Host it's docked in.
    --
    -- Reverting this property ensures that the container is stopped and
    -- removed.
    docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    docked ctr :: Container
    ctr@(Container Image
    _ Host
    h) =
    	(Container
    -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
    propagateContainerInfo Container
    ctr (ContainerName
    -> (ContainerId -> ContainerInfo -> Property Linux)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    go ContainerName
    "docked" ContainerId -> ContainerInfo -> Property Linux
    setup))
    		Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!>
    	(ContainerName
    -> (ContainerId -> ContainerInfo -> Property Linux)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    go ContainerName
    "undocked" ContainerId -> ContainerInfo -> Property Linux
    teardown)
      where
    	cn :: ContainerName
    cn = Host -> ContainerName
    hostName Host
    h

    	go :: ContainerName
    -> (ContainerId -> ContainerInfo -> Property Linux)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    go ContainerName
    desc ContainerId -> ContainerInfo -> Property Linux
    a = ContainerName
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' (ContainerName
    desc ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    " " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    cn) ((OuterMetaTypesWitness
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux]
      -> Propellor Result)
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w -> do
    		ContainerName
    hn <- (Host -> ContainerName) -> Propellor ContainerName
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Host -> ContainerName
    hostName
    		let cid :: ContainerId
    cid = ContainerName -> ContainerName -> ContainerId
    ContainerId ContainerName
    hn ContainerName
    cn
    		OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w (Property Linux -> Propellor Result)
    -> Property Linux -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerInfo -> Property Linux
    a ContainerId
    cid (ContainerId -> Container -> ContainerInfo
    mkContainerInfo ContainerId
    cid Container
    ctr)

    	setup :: ContainerId -> ContainerInfo -> Property Linux
    	setup :: ContainerId -> ContainerInfo -> Property Linux
    setup ContainerId
    cid (ContainerInfo Image
    image [ContainerName]
    runparams) =
    		ContainerId -> Property Linux
    provisionContainer ContainerId
    cid
    			Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires`
    		ContainerId -> Image -> [ContainerName] -> Property Linux
    runningContainer ContainerId
    cid Image
    image [ContainerName]
    runparams
    			Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires`
    		Property Linux
    Property (DebianLike + ArchLinux)
    installed

    	teardown :: ContainerId -> ContainerInfo -> Property Linux
    	teardown :: ContainerId -> ContainerInfo -> Property Linux
    teardown ContainerId
    cid (ContainerInfo Image
    image [ContainerName]
    _runparams) =
    		ContainerName -> Props Linux -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    combineProperties (ContainerName
    "undocked " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerId -> ContainerName
    fromContainerId ContainerId
    cid) (Props Linux -> Property Linux) -> Props Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ [Property Linux] -> Props Linux
    forall {k} (metatypes :: k).
    [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
    toProps
    			[ ContainerId -> Property Linux
    stoppedContainer ContainerId
    cid
    			, ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property (ContainerName
    "cleaned up " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerId -> ContainerName
    fromContainerId ContainerId
    cid) (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    				IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> Result
    report ([Bool] -> Result) -> IO [Bool] -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO Bool -> IO Bool) -> [IO Bool] -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM IO Bool -> IO Bool
    forall a. a -> a
    id
    					[ ContainerId -> IO Bool
    removeContainer ContainerId
    cid
    					, Image -> IO Bool
    forall i. ImageIdentifier i => i -> IO Bool
    removeImage Image
    image
    					]
    			]

    -- | Build the image from a directory containing a Dockerfile.
    imageBuilt :: HasImage c => FilePath -> c -> Property Linux
    imageBuilt :: forall c. HasImage c => ContainerName -> c -> Property Linux
    imageBuilt ContainerName
    directory c
    ctr = Property Linux
    built Property Linux -> ContainerName -> Property Linux
    forall p. IsProp p => p -> ContainerName -> p
    `describe` ContainerName
    msg
      where
    	msg :: ContainerName
    msg = ContainerName
    "docker image " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ (Image -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier Image
    image) ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    " built from " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    directory
    	built :: Property Linux
    	built :: Property Linux
    built = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		ContainerName
    -> [ContainerName]
    -> (CreateProcess -> CreateProcess)
    -> UncheckedProperty UnixLike
    Cmd.cmdProperty' ContainerName
    dockercmd [ContainerName
    "build", ContainerName
    "--tag", Image -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier Image
    image, ContainerName
    "./"] CreateProcess -> CreateProcess
    workDir
    			UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange
    	workDir :: CreateProcess -> CreateProcess
    workDir CreateProcess
    p = CreateProcess
    p { cwd :: Maybe ContainerName
    cwd = ContainerName -> Maybe ContainerName
    forall a. a -> Maybe a
    Just ContainerName
    directory }
    	image :: Image
    image = c -> Image
    forall a. HasImage a => a -> Image
    getImageName c
    ctr

    -- | Pull the image from the standard Docker Hub registry.
    imagePulled :: HasImage c => c -> Property Linux
    imagePulled :: forall c. HasImage c => c -> Property Linux
    imagePulled c
    ctr = Property Linux
    pulled Property Linux -> ContainerName -> Property Linux
    forall p. IsProp p => p -> ContainerName -> p
    `describe` ContainerName
    msg
      where
    	msg :: ContainerName
    msg = ContainerName
    "docker image " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ (Image -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier Image
    image) ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    " pulled"
    	pulled :: Property Linux
    	pulled :: Property Linux
    pulled = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		ContainerName -> [ContainerName] -> UncheckedProperty UnixLike
    Cmd.cmdProperty ContainerName
    dockercmd [ContainerName
    "pull", Image -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier Image
    image]
    			UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange
    	image :: Image
    image = c -> Image
    forall a. HasImage a => a -> Image
    getImageName c
    ctr

    propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
    propagateContainerInfo :: Container
    -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
    propagateContainerInfo ctr :: Container
    ctr@(Container Image
    _ Host
    h) Property (HasInfo + Linux)
    p =
    	ContainerName
    -> Container
    -> (PropagateInfo -> Bool)
    -> Property (HasInfo + Linux)
    -> Property (HasInfo + Linux)
    forall metatypes c.
    (IncludesInfo metatypes ~ 'True, IsContainer c) =>
    ContainerName
    -> c
    -> (PropagateInfo -> Bool)
    -> Property metatypes
    -> Property metatypes
    propagateContainer ContainerName
    cn Container
    ctr PropagateInfo -> Bool
    normalContainerInfo (Property (HasInfo + Linux) -> Property (HasInfo + Linux))
    -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
    forall a b. (a -> b) -> a -> b
    $
    		Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    Property (HasInfo + Linux)
    p Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    -> Info
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall metatypes.
    (IncludesInfo metatypes ~ 'True) =>
    Property metatypes -> Info -> Property metatypes
    `addInfoProperty` Info
    dockerinfo
      where
    	dockerinfo :: Info
    dockerinfo = DockerInfo -> Info
    dockerInfo (DockerInfo -> Info) -> DockerInfo -> Info
    forall a b. (a -> b) -> a -> b
    $
    		DockerInfo
    forall a. Monoid a => a
    mempty { _dockerContainers :: Map ContainerName Host
    _dockerContainers = ContainerName -> Host -> Map ContainerName Host
    forall k a. k -> a -> Map k a
    M.singleton ContainerName
    cn Host
    h }
    	cn :: ContainerName
    cn = Host -> ContainerName
    hostName Host
    h

    mkContainerInfo :: ContainerId -> Container -> ContainerInfo
    mkContainerInfo :: ContainerId -> Container -> ContainerInfo
    mkContainerInfo cid :: ContainerId
    cid@(ContainerId ContainerName
    hn ContainerName
    _cn) (Container Image
    img Host
    h) =
    	Image -> [ContainerName] -> ContainerInfo
    ContainerInfo Image
    img [ContainerName]
    runparams
      where
    	runparams :: [ContainerName]
    runparams = (DockerRunParam -> ContainerName)
    -> [DockerRunParam] -> [ContainerName]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(DockerRunParam ContainerName -> ContainerName
    mkparam) -> ContainerName -> ContainerName
    mkparam ContainerName
    hn)
    		(DockerInfo -> [DockerRunParam]
    _dockerRunParams DockerInfo
    info)
    	info :: DockerInfo
    info = Info -> DockerInfo
    forall v. IsInfo v => Info -> v
    fromInfo (Info -> DockerInfo) -> Info -> DockerInfo
    forall a b. (a -> b) -> a -> b
    $ Host -> Info
    hostInfo Host
    h'
    	h' :: Host
    h' = Host
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  (Combine
                     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux])
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux])
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    -> Host
    forall c metatypes. IsContainer c => c -> Props metatypes -> c
    setContainerProps Host
    h (Props
       (MetaTypes
          (Combine
             (Combine
                (Combine
                   '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                      'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                   '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                      'Targeting 'OSArchLinux])
                '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux])
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
     -> Host)
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  (Combine
                     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux])
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux])
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    -> Host
    forall a b. (a -> b) -> a -> b
    $ Host -> Props UnixLike
    forall c. IsContainer c => c -> Props UnixLike
    containerProps Host
    h
    		-- Restart by default so container comes up on
    		-- boot or when docker is upgraded.
    		Props UnixLike
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> Props
         (Sing
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&^"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    &^ Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    Property (HasInfo + Linux)
    restartAlways
    		-- Expose propellor directory inside the container.
    		Props
      (Sing
         (Combine
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> Props
         (Sing
            (Combine
               (Combine
                  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux])
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & ContainerName -> Property (HasInfo + Linux)
    forall v. Mountable v => v -> Property (HasInfo + Linux)
    volume (ContainerName
    localdirContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    ":"ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    localdir)
    		-- Name the container in a predictable way so we
    		-- and the user can easily find it later. This property
    		-- comes last, so it cannot be overridden.
    		Props
      (Sing
         (Combine
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux])
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  (Combine
                     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                        'Targeting 'OSArchLinux])
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux])
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & ContainerName -> Property (HasInfo + Linux)
    name (ContainerId -> ContainerName
    fromContainerId ContainerId
    cid)

    -- | Causes *any* docker images that are not in use by running containers to
    -- be deleted. And deletes any containers that propellor has set up
    -- before that are not currently running. Does not delete any containers
    -- that were not set up using propellor.
    --
    -- Generally, should come after the properties for the desired containers.
    garbageCollected :: Property Linux
    garbageCollected :: Property Linux
    garbageCollected = ContainerName -> Props Linux -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    propertyList ContainerName
    "docker garbage collected" (Props Linux -> Property Linux) -> Props Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ Props UnixLike
    props
    	Props UnixLike
    -> Property Linux
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & Property Linux
    gccontainers
    	Props Linux
    -> Property Linux
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & Property Linux
    gcimages
      where
    	gccontainers :: Property Linux
    	gccontainers :: Property Linux
    gccontainers = ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property ContainerName
    "docker containers garbage collected" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> Result
    report ([Bool] -> Result) -> IO [Bool] -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((ContainerId -> IO Bool) -> [ContainerId] -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ContainerId -> IO Bool
    removeContainer ([ContainerId] -> IO [Bool]) -> IO [ContainerId] -> IO [Bool]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ContainerFilter -> IO [ContainerId]
    listContainers ContainerFilter
    AllContainers)
    	gcimages :: Property Linux
    	gcimages :: Property Linux
    gcimages = ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property ContainerName
    "docker images garbage collected" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> Result
    report ([Bool] -> Result) -> IO [Bool] -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((ImageUID -> IO Bool) -> [ImageUID] -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ImageUID -> IO Bool
    forall i. ImageIdentifier i => i -> IO Bool
    removeImage ([ImageUID] -> IO [Bool]) -> IO [ImageUID] -> IO [Bool]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO [ImageUID]
    listImages)

    -- | Tweaks a container to work well with docker.
    --
    -- Currently, this consists of making pam_loginuid lines optional in
    -- the pam config, to work around <https://github.com/docker/docker/issues/5663>
    -- which affects docker 1.2.0.
    tweaked :: Property Linux
    tweaked :: Property Linux
    tweaked = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> [ContainerName] -> UncheckedProperty UnixLike
    cmdProperty ContainerName
    "sh"
    	[ ContainerName
    "-c"
    	, ContainerName
    "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"
    	]
    	UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    NoChange
    	Property UnixLike -> ContainerName -> Property UnixLike
    forall p. IsProp p => p -> ContainerName -> p
    `describe` ContainerName
    "tweaked for docker"

    -- | Configures the kernel to respect docker memory limits.
    --
    -- This assumes the system boots using grub 2. And that you don't need any
    -- other GRUB_CMDLINE_LINUX_DEFAULT settings.
    --
    -- Only takes effect after reboot. (Not automated.)
    memoryLimited :: Property DebianLike
    memoryLimited :: Property DebianLike
    memoryLimited = Property UnixLike -> Property DebianLike
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property DebianLike)
    -> Property UnixLike -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $
    	ContainerName
    "/etc/default/grub" ContainerName -> ContainerName -> Property UnixLike
    `File.containsLine` ContainerName
    cfg
    		Property UnixLike -> ContainerName -> Property UnixLike
    forall p. IsProp p => p -> ContainerName -> p
    `describe` ContainerName
    "docker memory limited"
    		Property UnixLike
    -> Property UnixLike
    -> CombinedType (Property UnixLike) (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` (ContainerName -> [ContainerName] -> UncheckedProperty UnixLike
    cmdProperty ContainerName
    "update-grub" [] UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange)
      where
    	cmdline :: ContainerName
    cmdline = ContainerName
    "cgroup_enable=memory swapaccount=1"
    	cfg :: ContainerName
    cfg = ContainerName
    "GRUB_CMDLINE_LINUX_DEFAULT=\""ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    cmdlineContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    "\""

    data ContainerInfo = ContainerInfo Image [RunParam]

    -- | Parameters to pass to `docker run` when creating a container.
    type RunParam = 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 = ContainerName -> ImageID
    ImageID (ContainerName -> ImageID) -> (i -> ContainerName) -> i -> ImageID
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier
    	-- | A string that Docker can use as an image identifier.
    	imageIdentifier :: i -> String

    instance ImageIdentifier ImageID where
    	imageIdentifier :: ImageID -> ContainerName
    imageIdentifier (ImageID ContainerName
    i) = ContainerName
    i
    	toImageID :: ImageID -> ImageID
    toImageID = ImageID -> ImageID
    forall a. a -> a
    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
    	{ Image -> ContainerName
    repository :: String
    	, Image -> Maybe ContainerName
    tag :: Maybe String
    	}
    	deriving (Image -> Image -> Bool
    (Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Image -> Image -> Bool
    == :: Image -> Image -> Bool
    $c/= :: Image -> Image -> Bool
    /= :: Image -> Image -> Bool
    Eq, ReadPrec [Image]
    ReadPrec Image
    Int -> ReadS Image
    ReadS [Image]
    (Int -> ReadS Image)
    -> ReadS [Image]
    -> ReadPrec Image
    -> ReadPrec [Image]
    -> Read Image
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Image
    readsPrec :: Int -> ReadS Image
    $creadList :: ReadS [Image]
    readList :: ReadS [Image]
    $creadPrec :: ReadPrec Image
    readPrec :: ReadPrec Image
    $creadListPrec :: ReadPrec [Image]
    readListPrec :: ReadPrec [Image]
    Read, Int -> Image -> ContainerName -> ContainerName
    [Image] -> ContainerName -> ContainerName
    Image -> ContainerName
    (Int -> Image -> ContainerName -> ContainerName)
    -> (Image -> ContainerName)
    -> ([Image] -> ContainerName -> ContainerName)
    -> Show Image
    forall a.
    (Int -> a -> ContainerName -> ContainerName)
    -> (a -> ContainerName)
    -> ([a] -> ContainerName -> ContainerName)
    -> Show a
    $cshowsPrec :: Int -> Image -> ContainerName -> ContainerName
    showsPrec :: Int -> Image -> ContainerName -> ContainerName
    $cshow :: Image -> ContainerName
    show :: Image -> ContainerName
    $cshowList :: [Image] -> ContainerName -> ContainerName
    showList :: [Image] -> ContainerName -> ContainerName
    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 :: ContainerName -> Image
    latestImage ContainerName
    repo = ContainerName -> Maybe ContainerName -> Image
    Image ContainerName
    repo Maybe ContainerName
    forall a. Maybe a
    Nothing

    instance ImageIdentifier Image where
    	-- | The format of the imageIdentifier of an `Image` is:
    	-- repository | repository:tag
    	imageIdentifier :: Image -> ContainerName
    imageIdentifier Image
    i = Image -> ContainerName
    repository Image
    i ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ (ContainerName
    -> (ContainerName -> ContainerName)
    -> Maybe ContainerName
    -> ContainerName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ContainerName
    "" (ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    (++) ContainerName
    ":") (Maybe ContainerName -> ContainerName)
    -> Maybe ContainerName -> ContainerName
    forall a b. (a -> b) -> a -> b
    $ Image -> Maybe ContainerName
    tag Image
    i)

    -- | The UID of an image. This UID is generated by Docker.
    newtype ImageUID = ImageUID String

    instance ImageIdentifier ImageUID where
    	imageIdentifier :: ImageUID -> ContainerName
    imageIdentifier (ImageUID ContainerName
    uid) = ContainerName
    uid

    -- | Set custom dns server for container.
    dns :: String -> Property (HasInfo + Linux)
    dns :: ContainerName -> Property (HasInfo + Linux)
    dns = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "dns"

    -- | Set container host name.
    hostname :: String -> Property (HasInfo + Linux)
    hostname :: ContainerName -> Property (HasInfo + Linux)
    hostname = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "hostname"

    -- | Set name of container.
    name :: String -> Property (HasInfo + Linux)
    name :: ContainerName -> Property (HasInfo + Linux)
    name = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "name"

    class Publishable p where
    	toPublish :: p -> String

    instance Publishable (Bound Port) where
    	toPublish :: Bound Port -> ContainerName
    toPublish Bound Port
    p = Port -> ContainerName
    forall t. ConfigurableValue t => t -> ContainerName
    val (Bound Port -> Port
    forall v. Bound v -> v
    hostSide Bound Port
    p) ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ":" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ Port -> ContainerName
    forall t. ConfigurableValue t => t -> ContainerName
    val (Bound Port -> Port
    forall v. Bound v -> v
    containerSide Bound Port
    p)

    -- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort
    instance Publishable String where
    	toPublish :: ContainerName -> ContainerName
    toPublish = ContainerName -> ContainerName
    forall a. a -> a
    id

    -- | Publish a container's port to the host
    publish :: Publishable p => p -> Property (HasInfo + Linux)
    publish :: forall p. Publishable p => p -> Property (HasInfo + Linux)
    publish = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "publish" (ContainerName
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> (p -> ContainerName)
    -> p
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p -> ContainerName
    forall p. Publishable p => p -> ContainerName
    toPublish

    -- | Expose a container's port without publishing it.
    expose :: String -> Property (HasInfo + Linux)
    expose :: ContainerName -> Property (HasInfo + Linux)
    expose = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "expose"

    -- | Username or UID for container.
    user :: String -> Property (HasInfo + Linux)
    user :: ContainerName -> Property (HasInfo + Linux)
    user = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "user"

    class Mountable p where
    	toMount :: p -> String

    instance Mountable (Bound FilePath) where
    	toMount :: Bound ContainerName -> ContainerName
    toMount Bound ContainerName
    p = Bound ContainerName -> ContainerName
    forall v. Bound v -> v
    hostSide Bound ContainerName
    p ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ":" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ Bound ContainerName -> ContainerName
    forall v. Bound v -> v
    containerSide Bound ContainerName
    p

    -- | string format: [host-dir]:[container-dir]:[rw|ro]
    --
    -- With just a directory, creates a volume in the container.
    instance Mountable String where
    	toMount :: ContainerName -> ContainerName
    toMount = ContainerName -> ContainerName
    forall a. a -> a
    id

    -- | Mount a volume
    volume :: Mountable v => v -> Property (HasInfo + Linux)
    volume :: forall v. Mountable v => v -> Property (HasInfo + Linux)
    volume = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "volume" (ContainerName
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> (v -> ContainerName)
    -> v
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> ContainerName
    forall p. Mountable p => p -> ContainerName
    toMount

    -- | Mount a volume from the specified container into the current
    -- container.
    volumes_from :: ContainerName -> Property (HasInfo + Linux)
    volumes_from :: ContainerName -> Property (HasInfo + Linux)
    volumes_from ContainerName
    cn = ContainerName
    -> (ContainerName -> ContainerName) -> Property (HasInfo + Linux)
    genProp ContainerName
    "volumes-from" ((ContainerName -> ContainerName) -> Property (HasInfo + Linux))
    -> (ContainerName -> ContainerName) -> Property (HasInfo + Linux)
    forall a b. (a -> b) -> a -> b
    $ \ContainerName
    hn ->
    	ContainerId -> ContainerName
    fromContainerId (ContainerName -> ContainerName -> ContainerId
    ContainerId ContainerName
    hn ContainerName
    cn)

    -- | Work dir inside the container.
    workdir :: String -> Property (HasInfo + Linux)
    workdir :: ContainerName -> Property (HasInfo + Linux)
    workdir = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "workdir"

    -- | Memory limit for container.
    -- Format: <number><optional unit>, where unit = b, k, m or g
    --
    -- Note: Only takes effect when the host has the memoryLimited property
    -- enabled.
    memory :: String -> Property (HasInfo + Linux)
    memory :: ContainerName -> Property (HasInfo + Linux)
    memory = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "memory"

    -- | CPU shares (relative weight).
    --
    -- By default, all containers run at the same priority, but you can tell
    -- the kernel to give more CPU time to a container using this property.
    cpuShares :: Int -> Property (HasInfo + Linux)
    cpuShares :: Int -> Property (HasInfo + Linux)
    cpuShares = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "cpu-shares" (ContainerName
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> (Int -> ContainerName)
    -> Int
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ContainerName
    forall a. Show a => a -> ContainerName
    show

    -- | Link with another container on the same host.
    link :: ContainerName -> ContainerAlias -> Property (HasInfo + Linux)
    link :: ContainerName -> ContainerName -> Property (HasInfo + Linux)
    link ContainerName
    linkwith ContainerName
    calias = ContainerName
    -> (ContainerName -> ContainerName) -> Property (HasInfo + Linux)
    genProp ContainerName
    "link" ((ContainerName -> ContainerName) -> Property (HasInfo + Linux))
    -> (ContainerName -> ContainerName) -> Property (HasInfo + Linux)
    forall a b. (a -> b) -> a -> b
    $ \ContainerName
    hn ->
    	ContainerId -> ContainerName
    fromContainerId (ContainerName -> ContainerName -> ContainerId
    ContainerId ContainerName
    hn ContainerName
    linkwith) ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ":" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    calias

    -- | A short alias for a linked container.
    -- Each container has its own alias namespace.
    type ContainerAlias = String

    -- | This property is enabled by default for docker containers configured by
    -- propellor; as well as keeping badly behaved containers running,
    -- it ensures that containers get started back up after reboot or
    -- after docker is upgraded.
    restartAlways :: Property (HasInfo + Linux)
    restartAlways :: Property (HasInfo + Linux)
    restartAlways = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "restart" ContainerName
    "always"

    -- | Docker will restart the container if it exits nonzero.
    -- If a number is provided, it will be restarted only up to that many
    -- times.
    restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
    restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
    restartOnFailure Maybe Int
    Nothing = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "restart" ContainerName
    "on-failure"
    restartOnFailure (Just Int
    n) = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "restart" (ContainerName
    "on-failure:" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ Int -> ContainerName
    forall a. Show a => a -> ContainerName
    show Int
    n)

    -- | Makes docker not restart a container when it exits
    -- Note that this includes not restarting it on boot!
    restartNever :: Property (HasInfo + Linux)
    restartNever :: Property (HasInfo + Linux)
    restartNever = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "restart" ContainerName
    "no"

    -- | Set environment variable with a tuple composed by the environment
    -- variable name and its value.
    environment :: (String, String) -> Property (HasInfo + Linux)
    environment :: (ContainerName, ContainerName) -> Property (HasInfo + Linux)
    environment (ContainerName
    k, ContainerName
    v) = ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    "env" (ContainerName -> Property (HasInfo + Linux))
    -> ContainerName -> Property (HasInfo + Linux)
    forall a b. (a -> b) -> a -> b
    $ ContainerName
    k ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    "=" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    v

    -- | A container is identified by its name, and the host
    -- on which it's deployed.
    data ContainerId = ContainerId
    	{ ContainerId -> ContainerName
    containerHostName :: HostName
    	, ContainerId -> ContainerName
    containerName :: ContainerName
    	}
    	deriving (ContainerId -> ContainerId -> Bool
    (ContainerId -> ContainerId -> Bool)
    -> (ContainerId -> ContainerId -> Bool) -> Eq ContainerId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContainerId -> ContainerId -> Bool
    == :: ContainerId -> ContainerId -> Bool
    $c/= :: ContainerId -> ContainerId -> Bool
    /= :: ContainerId -> ContainerId -> Bool
    Eq, ReadPrec [ContainerId]
    ReadPrec ContainerId
    Int -> ReadS ContainerId
    ReadS [ContainerId]
    (Int -> ReadS ContainerId)
    -> ReadS [ContainerId]
    -> ReadPrec ContainerId
    -> ReadPrec [ContainerId]
    -> Read ContainerId
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ContainerId
    readsPrec :: Int -> ReadS ContainerId
    $creadList :: ReadS [ContainerId]
    readList :: ReadS [ContainerId]
    $creadPrec :: ReadPrec ContainerId
    readPrec :: ReadPrec ContainerId
    $creadListPrec :: ReadPrec [ContainerId]
    readListPrec :: ReadPrec [ContainerId]
    Read, Int -> ContainerId -> ContainerName -> ContainerName
    [ContainerId] -> ContainerName -> ContainerName
    ContainerId -> ContainerName
    (Int -> ContainerId -> ContainerName -> ContainerName)
    -> (ContainerId -> ContainerName)
    -> ([ContainerId] -> ContainerName -> ContainerName)
    -> Show ContainerId
    forall a.
    (Int -> a -> ContainerName -> ContainerName)
    -> (a -> ContainerName)
    -> ([a] -> ContainerName -> ContainerName)
    -> Show a
    $cshowsPrec :: Int -> ContainerId -> ContainerName -> ContainerName
    showsPrec :: Int -> ContainerId -> ContainerName -> ContainerName
    $cshow :: ContainerId -> ContainerName
    show :: ContainerId -> ContainerName
    $cshowList :: [ContainerId] -> ContainerName -> ContainerName
    showList :: [ContainerId] -> ContainerName -> ContainerName
    Show)

    -- | Two containers with the same ContainerIdent were started from
    -- the same base image (possibly a different version though), and
    -- with the same RunParams.
    data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
    	deriving (ReadPrec [ContainerIdent]
    ReadPrec ContainerIdent
    Int -> ReadS ContainerIdent
    ReadS [ContainerIdent]
    (Int -> ReadS ContainerIdent)
    -> ReadS [ContainerIdent]
    -> ReadPrec ContainerIdent
    -> ReadPrec [ContainerIdent]
    -> Read ContainerIdent
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ContainerIdent
    readsPrec :: Int -> ReadS ContainerIdent
    $creadList :: ReadS [ContainerIdent]
    readList :: ReadS [ContainerIdent]
    $creadPrec :: ReadPrec ContainerIdent
    readPrec :: ReadPrec ContainerIdent
    $creadListPrec :: ReadPrec [ContainerIdent]
    readListPrec :: ReadPrec [ContainerIdent]
    Read, Int -> ContainerIdent -> ContainerName -> ContainerName
    [ContainerIdent] -> ContainerName -> ContainerName
    ContainerIdent -> ContainerName
    (Int -> ContainerIdent -> ContainerName -> ContainerName)
    -> (ContainerIdent -> ContainerName)
    -> ([ContainerIdent] -> ContainerName -> ContainerName)
    -> Show ContainerIdent
    forall a.
    (Int -> a -> ContainerName -> ContainerName)
    -> (a -> ContainerName)
    -> ([a] -> ContainerName -> ContainerName)
    -> Show a
    $cshowsPrec :: Int -> ContainerIdent -> ContainerName -> ContainerName
    showsPrec :: Int -> ContainerIdent -> ContainerName -> ContainerName
    $cshow :: ContainerIdent -> ContainerName
    show :: ContainerIdent -> ContainerName
    $cshowList :: [ContainerIdent] -> ContainerName -> ContainerName
    showList :: [ContainerIdent] -> ContainerName -> ContainerName
    Show, ContainerIdent -> ContainerIdent -> Bool
    (ContainerIdent -> ContainerIdent -> Bool)
    -> (ContainerIdent -> ContainerIdent -> Bool) -> Eq ContainerIdent
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContainerIdent -> ContainerIdent -> Bool
    == :: ContainerIdent -> ContainerIdent -> Bool
    $c/= :: ContainerIdent -> ContainerIdent -> Bool
    /= :: ContainerIdent -> ContainerIdent -> Bool
    Eq)

    toContainerId :: String -> Maybe ContainerId
    toContainerId :: ContainerName -> Maybe ContainerId
    toContainerId ContainerName
    s
    	| ContainerName
    myContainerSuffix ContainerName -> ContainerName -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` ContainerName
    s = case (Char -> Bool) -> ContainerName -> (ContainerName, ContainerName)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    separate (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') (ContainerName -> ContainerName
    forall {a}. [a] -> [a]
    desuffix ContainerName
    s) of
    		(ContainerName
    cn, ContainerName
    hn)
    			| ContainerName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ContainerName
    hn Bool -> Bool -> Bool
    || ContainerName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ContainerName
    cn -> Maybe ContainerId
    forall a. Maybe a
    Nothing
    			| Bool
    otherwise -> ContainerId -> Maybe ContainerId
    forall a. a -> Maybe a
    Just (ContainerId -> Maybe ContainerId)
    -> ContainerId -> Maybe ContainerId
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> ContainerName -> ContainerId
    ContainerId ContainerName
    hn ContainerName
    cn
    	| Bool
    otherwise = Maybe ContainerId
    forall a. Maybe a
    Nothing
      where
    	desuffix :: [a] -> [a]
    desuffix = [a] -> [a]
    forall {a}. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    len ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall {a}. [a] -> [a]
    reverse
    	len :: Int
    len = ContainerName -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ContainerName
    myContainerSuffix

    fromContainerId :: ContainerId -> String
    fromContainerId :: ContainerId -> ContainerName
    fromContainerId (ContainerId ContainerName
    hn ContainerName
    cn) = ContainerName
    cnContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    "."ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    hnContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    myContainerSuffix

    myContainerSuffix :: String
    myContainerSuffix :: ContainerName
    myContainerSuffix = ContainerName
    ".propellor"

    containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
    containerDesc :: forall i.
    IsProp (Property i) =>
    ContainerId -> Property i -> Property i
    containerDesc ContainerId
    cid Property i
    p = Property i
    p Property i -> ContainerName -> Property i
    forall p. IsProp p => p -> ContainerName -> p
    `describe` ContainerName
    desc
      where
    	desc :: ContainerName
    desc = ContainerName
    "container " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    " " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ Property i -> ContainerName
    forall p. IsProp p => p -> ContainerName
    getDesc Property i
    p

    runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
    runningContainer :: ContainerId -> Image -> [ContainerName] -> Property Linux
    runningContainer cid :: ContainerId
    cid@(ContainerId ContainerName
    hn ContainerName
    cn) Image
    image [ContainerName]
    runps = ContainerId -> Property Linux -> Property Linux
    forall i.
    IsProp (Property i) =>
    ContainerId -> Property i -> Property i
    containerDesc ContainerId
    cid (Property Linux -> Property Linux)
    -> Property Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property ContainerName
    "running" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    	[ContainerId]
    l <- IO [ContainerId] -> Propellor [ContainerId]
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [ContainerId] -> Propellor [ContainerId])
    -> IO [ContainerId] -> Propellor [ContainerId]
    forall a b. (a -> b) -> a -> b
    $ ContainerFilter -> IO [ContainerId]
    listContainers ContainerFilter
    RunningContainers
    	if ContainerId
    cid ContainerId -> [ContainerId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ContainerId]
    l
    		then Either ContainerName (Maybe ContainerIdent) -> Propellor Result
    checkident (Either ContainerName (Maybe ContainerIdent) -> Propellor Result)
    -> Propellor (Either ContainerName (Maybe ContainerIdent))
    -> Propellor Result
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either ContainerName (Maybe ContainerIdent))
    -> Propellor (Either ContainerName (Maybe ContainerIdent))
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Either ContainerName (Maybe ContainerIdent))
    getrunningident
    		else Propellor Bool
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> [ContainerId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem ContainerId
    cid ([ContainerId] -> Bool) -> IO [ContainerId] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerFilter -> IO [ContainerId]
    listContainers ContainerFilter
    AllContainers)
    			( do
    				-- The container exists, but is not
    				-- running. Its parameters may have
    				-- changed, but we cannot tell without
    				-- starting it up first.
    				Propellor Bool -> Propellor ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Propellor Bool -> Propellor ()) -> Propellor Bool -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> IO Bool
    startContainer ContainerId
    cid
    				-- It can take a while for the container to
    				-- start up enough for its ident file to be
    				-- written, so retry for up to 60 seconds.
    				Either ContainerName (Maybe ContainerIdent) -> Propellor Result
    checkident (Either ContainerName (Maybe ContainerIdent) -> Propellor Result)
    -> Propellor (Either ContainerName (Maybe ContainerIdent))
    -> Propellor Result
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either ContainerName (Maybe ContainerIdent))
    -> Propellor (Either ContainerName (Maybe ContainerIdent))
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Int
    -> IO (Either ContainerName (Maybe ContainerIdent))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall e a.
    Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
    retry Int
    60 (IO (Either ContainerName (Maybe ContainerIdent))
     -> IO (Either ContainerName (Maybe ContainerIdent)))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall a b. (a -> b) -> a -> b
    $ IO (Either ContainerName (Maybe ContainerIdent))
    getrunningident)
    			, Image -> Propellor Result
    forall i. ImageIdentifier i => i -> Propellor Result
    go Image
    image
    			)
      where
    	ident :: ContainerIdent
    ident = Image
    -> ContainerName
    -> ContainerName
    -> [ContainerName]
    -> ContainerIdent
    ContainerIdent Image
    image ContainerName
    hn ContainerName
    cn [ContainerName]
    runps

    	-- Check if the ident has changed; if so the
    	-- parameters of the container differ and it must
    	-- be restarted.
    	checkident :: Either ContainerName (Maybe ContainerIdent) -> Propellor Result
    checkident (Right Maybe ContainerIdent
    runningident)
    		| Maybe ContainerIdent
    runningident Maybe ContainerIdent -> Maybe ContainerIdent -> Bool
    forall a. Eq a => a -> a -> Bool
    == ContainerIdent -> Maybe ContainerIdent
    forall a. a -> Maybe a
    Just ContainerIdent
    ident = Propellor Result
    noChange
    		| Bool
    otherwise = do
    			Propellor Bool -> Propellor ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Propellor Bool -> Propellor ()) -> Propellor Bool -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> IO Bool
    stopContainer ContainerId
    cid
    			Propellor Result
    restartcontainer
    	checkident (Left ContainerName
    errmsg) = do
    		ContainerName -> Propellor ()
    forall (m :: * -> *). MonadIO m => ContainerName -> m ()
    warningMessage ContainerName
    errmsg
    		Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange

    	restartcontainer :: Propellor Result
    restartcontainer = do
    		ImageID
    oldimage <- IO ImageID -> Propellor ImageID
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ImageID -> Propellor ImageID)
    -> IO ImageID -> Propellor ImageID
    forall a b. (a -> b) -> a -> b
    $
    			ImageID -> (ImageUID -> ImageID) -> Maybe ImageUID -> ImageID
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Image -> ImageID
    forall i. ImageIdentifier i => i -> ImageID
    toImageID Image
    image) ImageUID -> ImageID
    forall i. ImageIdentifier i => i -> ImageID
    toImageID (Maybe ImageUID -> ImageID) -> IO (Maybe ImageUID) -> IO ImageID
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerId -> IO (Maybe ImageUID)
    commitContainer ContainerId
    cid
    		Propellor Bool -> Propellor ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Propellor Bool -> Propellor ()) -> Propellor Bool -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> IO Bool
    removeContainer ContainerId
    cid
    		ImageID -> Propellor Result
    forall i. ImageIdentifier i => i -> Propellor Result
    go ImageID
    oldimage

    	getrunningident :: IO (Either ContainerName (Maybe ContainerIdent))
    getrunningident = ContainerName
    -> (ContainerName
        -> Handle -> IO (Either ContainerName (Maybe ContainerIdent)))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    ContainerName -> (ContainerName -> Handle -> m a) -> m a
    withTmpFile ContainerName
    "dockerrunsane" ((ContainerName
      -> Handle -> IO (Either ContainerName (Maybe ContainerIdent)))
     -> IO (Either ContainerName (Maybe ContainerIdent)))
    -> (ContainerName
        -> Handle -> IO (Either ContainerName (Maybe ContainerIdent)))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall a b. (a -> b) -> a -> b
    $ \ContainerName
    t Handle
    h -> do
    		-- detect #774376 which caused docker exec to not enter
    		-- the container namespace, and be able to access files
    		-- outside
    		Handle -> IO ()
    hClose Handle
    h
    		IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ())
    -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
        -> IO Bool)
    -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProcessHandle -> IO Bool
    checkSuccessProcess (ProcessHandle -> IO Bool)
    -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
        -> ProcessHandle)
    -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> ProcessHandle
    processHandle ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
     -> IO ())
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
    			CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess (ContainerId -> [ContainerName] -> [ContainerName] -> CreateProcess
    inContainerProcess ContainerId
    cid []
    				[ContainerName
    "rm", ContainerName
    "-f", ContainerName
    t])
    		IO Bool
    -> (IO (Either ContainerName (Maybe ContainerIdent)),
        IO (Either ContainerName (Maybe ContainerIdent)))
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (ContainerName -> IO Bool
    doesFileExist ContainerName
    t)
    			( Maybe ContainerIdent -> Either ContainerName (Maybe ContainerIdent)
    forall a b. b -> Either a b
    Right (Maybe ContainerIdent
     -> Either ContainerName (Maybe ContainerIdent))
    -> (ContainerName -> Maybe ContainerIdent)
    -> ContainerName
    -> Either ContainerName (Maybe ContainerIdent)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerName -> Maybe ContainerIdent
    forall a. Read a => ContainerName -> Maybe a
    readish (ContainerName -> Either ContainerName (Maybe ContainerIdent))
    -> IO ContainerName
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
    				CreateProcess -> IO ContainerName
    readProcess' (ContainerId -> [ContainerName] -> [ContainerName] -> CreateProcess
    inContainerProcess ContainerId
    cid []
    					[ContainerName
    "cat", ContainerName
    propellorIdent])
    			, Either ContainerName (Maybe ContainerIdent)
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ContainerName (Maybe ContainerIdent)
     -> IO (Either ContainerName (Maybe ContainerIdent)))
    -> Either ContainerName (Maybe ContainerIdent)
    -> IO (Either ContainerName (Maybe ContainerIdent))
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> Either ContainerName (Maybe ContainerIdent)
    forall a b. a -> Either a b
    Left ContainerName
    "docker exec failed to enter chroot properly (maybe an old kernel version?)"
    			)

    	retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
    	retry :: forall e a.
    Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
    retry Int
    0 IO (Either e (Maybe a))
    _ = Either e (Maybe a) -> IO (Either e (Maybe a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> Either e (Maybe a)
    forall a b. b -> Either a b
    Right Maybe a
    forall a. Maybe a
    Nothing)
    	retry Int
    n IO (Either e (Maybe a))
    a = do
    		Either e (Maybe a)
    v <- IO (Either e (Maybe a))
    a
    		case Either e (Maybe a)
    v of
    			Right Maybe a
    Nothing -> do
    				Seconds -> IO ()
    threadDelaySeconds (Int -> Seconds
    Seconds Int
    1)
    				Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
    forall e a.
    Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
    retry (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) IO (Either e (Maybe a))
    a
    			Either e (Maybe a)
    _ -> Either e (Maybe a) -> IO (Either e (Maybe a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either e (Maybe a)
    v

    	go :: ImageIdentifier i => i -> Propellor Result
    	go :: forall i. ImageIdentifier i => i -> Propellor Result
    go i
    img = IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ do
    		ContainerId -> IO ()
    clearProvisionedFlag ContainerId
    cid
    		Bool -> ContainerName -> IO ()
    createDirectoryIfMissing Bool
    True (ContainerName -> ContainerName
    takeDirectory (ContainerName -> ContainerName) -> ContainerName -> ContainerName
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerName
    identFile ContainerId
    cid)
    		ContainerName
    shim <- ContainerName
    -> Maybe ContainerName -> ContainerName -> IO ContainerName
    Shim.setup (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerName
    "propellor") Maybe ContainerName
    forall a. Maybe a
    Nothing (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    shimdir ContainerId
    cid)
    		ContainerName -> ContainerName -> IO ()
    writeFile (ContainerId -> ContainerName
    identFile ContainerId
    cid) (ContainerIdent -> ContainerName
    forall a. Show a => a -> ContainerName
    show ContainerIdent
    ident)
    		Bool -> Result
    forall t. ToResult t => t -> Result
    toResult (Bool -> Result) -> IO Bool -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> i -> [ContainerName] -> [ContainerName] -> IO Bool
    forall i.
    ImageIdentifier i =>
    i -> [ContainerName] -> [ContainerName] -> IO Bool
    runContainer i
    img
    			([ContainerName]
    runps [ContainerName] -> [ContainerName] -> [ContainerName]
    forall a. [a] -> [a] -> [a]
    ++ [ContainerName
    "-i", ContainerName
    "-d", ContainerName
    "-t"])
    			[ContainerName
    shim, ContainerName
    "--continue", CmdLine -> ContainerName
    forall a. Show a => a -> ContainerName
    show (ContainerName -> CmdLine
    DockerInit (ContainerId -> ContainerName
    fromContainerId ContainerId
    cid))]

    -- | Called when propellor is running inside a docker container.
    -- The string should be the container's ContainerId.
    --
    -- This process is effectively init inside the container.
    -- It even needs to wait on zombie processes!
    --
    -- In the foreground, run an interactive bash (or sh) shell,
    -- so that the user can interact with it when attached to the container.
    --
    -- When the system reboots, docker restarts the container, and this is run
    -- again. So, to make the necessary services get started on boot, this needs
    -- to provision the container then. However, if the container is already
    -- being provisioned by the calling propellor, it would be redundant and
    -- problimatic to also provisoon it here, when not booting up.
    --
    -- The solution is a flag file. If the flag file exists, then the container
    -- was already provisioned. So, it must be a reboot, and time to provision
    -- again. If the flag file doesn't exist, don't provision here.
    init :: String -> IO ()
    init :: ContainerName -> IO ()
    init ContainerName
    s = case ContainerName -> Maybe ContainerId
    toContainerId ContainerName
    s of
    	Maybe ContainerId
    Nothing -> ContainerName -> IO ()
    forall a. HasCallStack => ContainerName -> a
    error (ContainerName -> IO ()) -> ContainerName -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ContainerName
    "Invalid ContainerId: " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    s
    	Just ContainerId
    cid -> do
    		ContainerName -> IO ()
    changeWorkingDirectory ContainerName
    localdir
    		ContainerName -> ContainerName -> IO ()
    writeFile ContainerName
    propellorIdent (ContainerName -> IO ())
    -> (ContainerIdent -> ContainerName) -> ContainerIdent -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerIdent -> ContainerName
    forall a. Show a => a -> ContainerName
    show (ContainerIdent -> IO ()) -> IO ContainerIdent -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ContainerId -> IO ContainerIdent
    readIdentFile ContainerId
    cid
    		IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (ContainerId -> IO Bool
    checkProvisionedFlag ContainerId
    cid) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    			let shim :: ContainerName
    shim = ContainerName -> ContainerName -> ContainerName
    Shim.file (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerName
    "propellor") (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    shimdir ContainerId
    cid)
    			IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    shim [ContainerName -> CommandParam
    Param ContainerName
    "--continue", ContainerName -> CommandParam
    Param (ContainerName -> CommandParam) -> ContainerName -> CommandParam
    forall a b. (a -> b) -> a -> b
    $ CmdLine -> ContainerName
    forall a. Show a => a -> ContainerName
    show (CmdLine -> ContainerName) -> CmdLine -> ContainerName
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> CmdLine
    toChain ContainerId
    cid]) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				ContainerName -> IO ()
    forall (m :: * -> *). MonadIO m => ContainerName -> m ()
    warningMessage ContainerName
    "Boot provision failed!"
    		IO (Async Any) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Async Any) -> IO ()) -> IO (Async Any) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO Any -> IO (Async Any)
    forall a. IO a -> IO (Async a)
    async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO Any
    forall {a} {b}. IO a -> IO b
    job IO ()
    reapzombies
    		IO () -> IO ()
    forall {a} {b}. IO a -> IO b
    job (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    			IO ()
    flushConcurrentOutput
    			IO (Either IOException Bool) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either IOException Bool) -> IO ())
    -> IO (Either IOException Bool) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO (Either IOException Bool)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either IOException a)
    tryIO (IO Bool -> IO (Either IOException Bool))
    -> IO Bool -> IO (Either IOException Bool)
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> (IO Bool, IO Bool) -> IO Bool
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (ContainerName -> IO Bool
    inPath ContainerName
    "bash")
    				( ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    "bash" [ContainerName -> CommandParam
    Param ContainerName
    "-l"]
    				, ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    "/bin/sh" []
    				)
    			ContainerName -> IO ()
    putStrLn ContainerName
    "Container is still running. Press ^P^Q to detach."
      where
    	job :: IO a -> IO b
    job = IO () -> IO b
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO b) -> (IO a -> IO ()) -> IO a -> IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Either IOException a) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either IOException a) -> IO ())
    -> (IO a -> IO (Either IOException a)) -> IO a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> IO (Either IOException a)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either IOException a)
    tryIO
    	reapzombies :: IO ()
    reapzombies = IO (Maybe (ProcessID, ProcessStatus)) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe (ProcessID, ProcessStatus)) -> IO ())
    -> IO (Maybe (ProcessID, ProcessStatus)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
    getAnyProcessStatus Bool
    True Bool
    False

    -- | Once a container is running, propellor can be run inside
    -- it to provision it.
    provisionContainer :: ContainerId -> Property Linux
    provisionContainer :: ContainerId -> Property Linux
    provisionContainer ContainerId
    cid = ContainerId -> Property Linux -> Property Linux
    forall i.
    IsProp (Property i) =>
    ContainerId -> Property i -> Property i
    containerDesc ContainerId
    cid (Property Linux -> Property Linux)
    -> Property Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property ContainerName
    "provisioned" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ do
    	let shim :: ContainerName
    shim = ContainerName -> ContainerName -> ContainerName
    Shim.file (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerName
    "propellor") (ContainerName
    localdir ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    shimdir ContainerId
    cid)
    	let params :: [ContainerName]
    params = [ContainerName
    "--continue", CmdLine -> ContainerName
    forall a. Show a => a -> ContainerName
    show (CmdLine -> ContainerName) -> CmdLine -> ContainerName
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> CmdLine
    toChain ContainerId
    cid]
    	MessageHandle
    msgh <- IO MessageHandle
    getMessageHandle
    	let p :: CreateProcess
    p = ContainerId -> [ContainerName] -> [ContainerName] -> CreateProcess
    inContainerProcess ContainerId
    cid
    		(if MessageHandle -> Bool
    isConsole MessageHandle
    msgh then [ContainerName
    "-it"] else [])
    		(ContainerName
    shim ContainerName -> [ContainerName] -> [ContainerName]
    forall a. a -> [a] -> [a]
    : [ContainerName]
    params)
    	Result
    r <- CreateProcess -> IO Result
    chainPropellor CreateProcess
    p
    	Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Result
    r Result -> Result -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Result
    FailedChange) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    		ContainerId -> IO ()
    setProvisionedFlag ContainerId
    cid
    	Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    r

    toChain :: ContainerId -> CmdLine
    toChain :: ContainerId -> CmdLine
    toChain ContainerId
    cid = ContainerName -> ContainerName -> CmdLine
    DockerChain (ContainerId -> ContainerName
    containerHostName ContainerId
    cid) (ContainerId -> ContainerName
    fromContainerId ContainerId
    cid)

    chain :: [Host] -> HostName -> String -> IO ()
    chain :: [Host] -> ContainerName -> ContainerName -> IO ()
    chain [Host]
    hostlist ContainerName
    hn ContainerName
    s = case ContainerName -> Maybe ContainerId
    toContainerId ContainerName
    s of
    	Maybe ContainerId
    Nothing -> ContainerName -> IO ()
    forall (m :: * -> *) a. MonadIO m => ContainerName -> m a
    errorMessage ContainerName
    "bad container id"
    	Just ContainerId
    cid -> case [Host] -> ContainerName -> Maybe Host
    findHostNoAlias [Host]
    hostlist ContainerName
    hn of
    		Maybe Host
    Nothing -> ContainerName -> IO ()
    forall (m :: * -> *) a. MonadIO m => ContainerName -> m a
    errorMessage (ContainerName
    "cannot find host " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    hn)
    		Just Host
    parenthost -> case ContainerName -> Map ContainerName Host -> Maybe Host
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (ContainerId -> ContainerName
    containerName ContainerId
    cid) (DockerInfo -> Map ContainerName Host
    _dockerContainers (DockerInfo -> Map ContainerName Host)
    -> DockerInfo -> Map ContainerName Host
    forall a b. (a -> b) -> a -> b
    $ Info -> DockerInfo
    forall v. IsInfo v => Info -> v
    fromInfo (Info -> DockerInfo) -> Info -> DockerInfo
    forall a b. (a -> b) -> a -> b
    $ Host -> Info
    hostInfo Host
    parenthost) of
    			Maybe Host
    Nothing -> ContainerName -> IO ()
    forall (m :: * -> *) a. MonadIO m => ContainerName -> m a
    errorMessage (ContainerName
    "cannot find container " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerId -> ContainerName
    containerName ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    " docked on host " ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    hn)
    			Just Host
    h -> ContainerId -> Host -> IO ()
    go ContainerId
    cid Host
    h
      where
    	go :: ContainerId -> Host -> IO ()
    go ContainerId
    cid Host
    h = do
    		ContainerName -> IO ()
    changeWorkingDirectory ContainerName
    localdir
    		ContainerName -> IO () -> IO ()
    forall a. ContainerName -> IO a -> IO a
    onlyProcess (ContainerId -> ContainerName
    provisioningLock ContainerId
    cid) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    			Host -> Propellor Result -> IO ()
    runChainPropellor (Host -> Host
    setcaps Host
    h) (Propellor Result -> IO ()) -> Propellor Result -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				[ChildProperty] -> Propellor Result
    ensureChildProperties ([ChildProperty] -> Propellor Result)
    -> [ChildProperty] -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ Host -> [ChildProperty]
    hostProperties Host
    h
    	setcaps :: Host -> Host
    setcaps Host
    h = Host
    h { hostInfo :: Info
    hostInfo = Host -> Info
    hostInfo Host
    h Info -> [ContainerCapability] -> Info
    forall v. IsInfo v => Info -> v -> Info
    `addInfo` [ContainerCapability
    HostnameContained, ContainerCapability
    FilesystemContained] }

    stopContainer :: ContainerId -> IO Bool
    stopContainer :: ContainerId -> IO Bool
    stopContainer ContainerId
    cid = ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    dockercmd [ContainerName -> CommandParam
    Param ContainerName
    "stop", ContainerName -> CommandParam
    Param (ContainerName -> CommandParam) -> ContainerName -> CommandParam
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ]

    startContainer :: ContainerId -> IO Bool
    startContainer :: ContainerId -> IO Bool
    startContainer ContainerId
    cid = ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    dockercmd [ContainerName -> CommandParam
    Param ContainerName
    "start", ContainerName -> CommandParam
    Param (ContainerName -> CommandParam) -> ContainerName -> CommandParam
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ]

    stoppedContainer :: ContainerId -> Property Linux
    stoppedContainer :: ContainerId -> Property Linux
    stoppedContainer ContainerId
    cid = ContainerId -> Property Linux -> Property Linux
    forall i.
    IsProp (Property i) =>
    ContainerId -> Property i -> Property i
    containerDesc ContainerId
    cid (Property Linux -> Property Linux)
    -> Property Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ ContainerName
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' ContainerName
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux]
      -> Propellor Result)
     -> Property Linux)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w ->
    	Propellor Bool
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> [ContainerId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem ContainerId
    cid ([ContainerId] -> Bool) -> IO [ContainerId] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerFilter -> IO [ContainerId]
    listContainers ContainerFilter
    RunningContainers)
    		( IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ()
    cleanup Propellor () -> Propellor Result -> Propellor Result
    forall (m :: * -> *) b a. Monad m => m b -> m a -> m a
    `after` OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w Property Linux
    stop
    		, Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    		)
      where
    	desc :: ContainerName
    desc = ContainerName
    "stopped"
    	stop :: Property Linux
    	stop :: Property Linux
    stop = ContainerName -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    ContainerName -> Propellor Result -> Property (MetaTypes metatypes)
    property ContainerName
    desc (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ Bool -> Result
    forall t. ToResult t => t -> Result
    toResult (Bool -> Result) -> IO Bool -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerId -> IO Bool
    stopContainer ContainerId
    cid
    	cleanup :: IO ()
    cleanup = do
    		ContainerName -> IO ()
    nukeFile (ContainerName -> IO ()) -> ContainerName -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerName
    identFile ContainerId
    cid
    		ContainerName -> IO ()
    removeDirectoryRecursive (ContainerName -> IO ()) -> ContainerName -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ContainerId -> ContainerName
    shimdir ContainerId
    cid
    		ContainerId -> IO ()
    clearProvisionedFlag ContainerId
    cid

    removeContainer :: ContainerId -> IO Bool
    removeContainer :: ContainerId -> IO Bool
    removeContainer ContainerId
    cid = IO Bool -> IO Bool
    forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
    catchBoolIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    	(ContainerName, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ((ContainerName, Bool) -> Bool)
    -> IO (ContainerName, Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName
    -> [ContainerName]
    -> Maybe ContainerName
    -> IO (ContainerName, Bool)
    processTranscript ContainerName
    dockercmd [ContainerName
    "rm", ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ] Maybe ContainerName
    forall a. Maybe a
    Nothing

    removeImage :: ImageIdentifier i => i -> IO Bool
    removeImage :: forall i. ImageIdentifier i => i -> IO Bool
    removeImage i
    image = IO Bool -> IO Bool
    forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
    catchBoolIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    	(ContainerName, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ((ContainerName, Bool) -> Bool)
    -> IO (ContainerName, Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName
    -> [ContainerName]
    -> Maybe ContainerName
    -> IO (ContainerName, Bool)
    processTranscript ContainerName
    dockercmd [ContainerName
    "rmi", i -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier i
    image] Maybe ContainerName
    forall a. Maybe a
    Nothing

    runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool
    runContainer :: forall i.
    ImageIdentifier i =>
    i -> [ContainerName] -> [ContainerName] -> IO Bool
    runContainer i
    image [ContainerName]
    ps [ContainerName]
    cmd = ContainerName -> [CommandParam] -> IO Bool
    boolSystem ContainerName
    dockercmd ([CommandParam] -> IO Bool) -> [CommandParam] -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ (ContainerName -> CommandParam)
    -> [ContainerName] -> [CommandParam]
    forall a b. (a -> b) -> [a] -> [b]
    map ContainerName -> CommandParam
    Param ([ContainerName] -> [CommandParam])
    -> [ContainerName] -> [CommandParam]
    forall a b. (a -> b) -> a -> b
    $
    	ContainerName
    "run" ContainerName -> [ContainerName] -> [ContainerName]
    forall a. a -> [a] -> [a]
    : ([ContainerName]
    ps [ContainerName] -> [ContainerName] -> [ContainerName]
    forall a. [a] -> [a] -> [a]
    ++ (i -> ContainerName
    forall i. ImageIdentifier i => i -> ContainerName
    imageIdentifier i
    image) ContainerName -> [ContainerName] -> [ContainerName]
    forall a. a -> [a] -> [a]
    : [ContainerName]
    cmd)

    inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
    inContainerProcess :: ContainerId -> [ContainerName] -> [ContainerName] -> CreateProcess
    inContainerProcess ContainerId
    cid [ContainerName]
    ps [ContainerName]
    cmd = ContainerName -> [ContainerName] -> CreateProcess
    proc ContainerName
    dockercmd (ContainerName
    "exec" ContainerName -> [ContainerName] -> [ContainerName]
    forall a. a -> [a] -> [a]
    : [ContainerName]
    ps [ContainerName] -> [ContainerName] -> [ContainerName]
    forall a. [a] -> [a] -> [a]
    ++ [ContainerId -> ContainerName
    fromContainerId ContainerId
    cid] [ContainerName] -> [ContainerName] -> [ContainerName]
    forall a. [a] -> [a] -> [a]
    ++ [ContainerName]
    cmd)

    commitContainer :: ContainerId -> IO (Maybe ImageUID)
    commitContainer :: ContainerId -> IO (Maybe ImageUID)
    commitContainer ContainerId
    cid = IO ImageUID -> IO (Maybe ImageUID)
    forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
    catchMaybeIO (IO ImageUID -> IO (Maybe ImageUID))
    -> IO ImageUID -> IO (Maybe ImageUID)
    forall a b. (a -> b) -> a -> b
    $
    	ContainerName -> ImageUID
    ImageUID (ContainerName -> ImageUID)
    -> (ContainerName -> ContainerName) -> ContainerName -> ImageUID
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ContainerName -> ContainerName
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')
    		(ContainerName -> ImageUID) -> IO ContainerName -> IO ImageUID
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName -> [ContainerName] -> IO ContainerName
    readProcess ContainerName
    dockercmd [ContainerName
    "commit", ContainerId -> ContainerName
    fromContainerId ContainerId
    cid]

    data ContainerFilter = RunningContainers | AllContainers
    	deriving (ContainerFilter -> ContainerFilter -> Bool
    (ContainerFilter -> ContainerFilter -> Bool)
    -> (ContainerFilter -> ContainerFilter -> Bool)
    -> Eq ContainerFilter
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContainerFilter -> ContainerFilter -> Bool
    == :: ContainerFilter -> ContainerFilter -> Bool
    $c/= :: ContainerFilter -> ContainerFilter -> Bool
    /= :: ContainerFilter -> ContainerFilter -> Bool
    Eq)

    -- | Only lists propellor managed containers.
    listContainers :: ContainerFilter -> IO [ContainerId]
    listContainers :: ContainerFilter -> IO [ContainerId]
    listContainers ContainerFilter
    status =
    	(ContainerName -> Maybe ContainerId)
    -> [ContainerName] -> [ContainerId]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ContainerName -> Maybe ContainerId
    toContainerId ([ContainerName] -> [ContainerId])
    -> (ContainerName -> [ContainerName])
    -> ContainerName
    -> [ContainerId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ContainerName -> [ContainerName])
    -> [ContainerName] -> [ContainerName]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (ContainerName -> ContainerName -> [ContainerName]
    forall a. Eq a => [a] -> [a] -> [[a]]
    split ContainerName
    ",")
    		([ContainerName] -> [ContainerName])
    -> (ContainerName -> [ContainerName])
    -> ContainerName
    -> [ContainerName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ContainerName -> Maybe ContainerName)
    -> [ContainerName] -> [ContainerName]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ([ContainerName] -> Maybe ContainerName
    forall a. [a] -> Maybe a
    lastMaybe ([ContainerName] -> Maybe ContainerName)
    -> (ContainerName -> [ContainerName])
    -> ContainerName
    -> Maybe ContainerName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerName -> [ContainerName]
    words) ([ContainerName] -> [ContainerName])
    -> (ContainerName -> [ContainerName])
    -> ContainerName
    -> [ContainerName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerName -> [ContainerName]
    lines
    		(ContainerName -> [ContainerId])
    -> IO ContainerName -> IO [ContainerId]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName -> [ContainerName] -> IO ContainerName
    readProcess ContainerName
    dockercmd [ContainerName]
    ps
      where
    	ps :: [ContainerName]
    ps
    		| ContainerFilter
    status ContainerFilter -> ContainerFilter -> Bool
    forall a. Eq a => a -> a -> Bool
    == ContainerFilter
    AllContainers = [ContainerName]
    baseps [ContainerName] -> [ContainerName] -> [ContainerName]
    forall a. [a] -> [a] -> [a]
    ++ [ContainerName
    "--all"]
    		| Bool
    otherwise = [ContainerName]
    baseps
    	baseps :: [ContainerName]
    baseps = [ContainerName
    "ps", ContainerName
    "--no-trunc"]

    listImages :: IO [ImageUID]
    listImages :: IO [ImageUID]
    listImages = (ContainerName -> ImageUID) -> [ContainerName] -> [ImageUID]
    forall a b. (a -> b) -> [a] -> [b]
    map ContainerName -> ImageUID
    ImageUID ([ContainerName] -> [ImageUID])
    -> (ContainerName -> [ContainerName])
    -> ContainerName
    -> [ImageUID]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerName -> [ContainerName]
    lines (ContainerName -> [ImageUID]) -> IO ContainerName -> IO [ImageUID]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName -> [ContainerName] -> IO ContainerName
    readProcess ContainerName
    dockercmd [ContainerName
    "images", ContainerName
    "--all", ContainerName
    "--quiet"]

    runProp :: String -> RunParam -> Property (HasInfo + Linux)
    runProp :: ContainerName -> ContainerName -> Property (HasInfo + Linux)
    runProp ContainerName
    field ContainerName
    v = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property
       (MetaTypes
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> DockerInfo -> Property (HasInfo + UnixLike)
    forall v.
    IsInfo v =>
    ContainerName -> v -> Property (HasInfo + UnixLike)
    pureInfoProperty (ContainerName
    param) (DockerInfo -> Property (HasInfo + UnixLike))
    -> DockerInfo -> Property (HasInfo + UnixLike)
    forall a b. (a -> b) -> a -> b
    $
    	DockerInfo
    forall a. Monoid a => a
    mempty { _dockerRunParams :: [DockerRunParam]
    _dockerRunParams = [(ContainerName -> ContainerName) -> DockerRunParam
    DockerRunParam (\ContainerName
    _ -> ContainerName
    "--"ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    param)] }
      where
    	param :: ContainerName
    param = ContainerName
    fieldContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    "="ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    v

    genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux)
    genProp :: ContainerName
    -> (ContainerName -> ContainerName) -> Property (HasInfo + Linux)
    genProp ContainerName
    field ContainerName -> ContainerName
    mkval = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property
       (MetaTypes
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall a b. (a -> b) -> a -> b
    $ ContainerName -> DockerInfo -> Property (HasInfo + UnixLike)
    forall v.
    IsInfo v =>
    ContainerName -> v -> Property (HasInfo + UnixLike)
    pureInfoProperty ContainerName
    field (DockerInfo -> Property (HasInfo + UnixLike))
    -> DockerInfo -> Property (HasInfo + UnixLike)
    forall a b. (a -> b) -> a -> b
    $
    	DockerInfo
    forall a. Monoid a => a
    mempty { _dockerRunParams :: [DockerRunParam]
    _dockerRunParams = [(ContainerName -> ContainerName) -> DockerRunParam
    DockerRunParam (\ContainerName
    hn -> ContainerName
    "--"ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    fieldContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ContainerName
    "=" ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName -> ContainerName
    mkval ContainerName
    hn)] }

    dockerInfo :: DockerInfo -> Info
    dockerInfo :: DockerInfo -> Info
    dockerInfo DockerInfo
    i = Info
    forall a. Monoid a => a
    mempty Info -> DockerInfo -> Info
    forall v. IsInfo v => Info -> v -> Info
    `addInfo` DockerInfo
    i

    -- | 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.
    propellorIdent :: FilePath
    propellorIdent :: ContainerName
    propellorIdent = ContainerName
    "/.propellor-ident"

    provisionedFlag :: ContainerId -> FilePath
    provisionedFlag :: ContainerId -> ContainerName
    provisionedFlag ContainerId
    cid = ContainerName
    "docker" ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ".provisioned"

    clearProvisionedFlag :: ContainerId -> IO ()
    clearProvisionedFlag :: ContainerId -> IO ()
    clearProvisionedFlag = ContainerName -> IO ()
    nukeFile (ContainerName -> IO ())
    -> (ContainerId -> ContainerName) -> ContainerId -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerId -> ContainerName
    provisionedFlag

    setProvisionedFlag :: ContainerId -> IO ()
    setProvisionedFlag :: ContainerId -> IO ()
    setProvisionedFlag ContainerId
    cid = do
    	Bool -> ContainerName -> IO ()
    createDirectoryIfMissing Bool
    True (ContainerName -> ContainerName
    takeDirectory (ContainerId -> ContainerName
    provisionedFlag ContainerId
    cid))
    	ContainerName -> ContainerName -> IO ()
    writeFile (ContainerId -> ContainerName
    provisionedFlag ContainerId
    cid) ContainerName
    "1"

    checkProvisionedFlag :: ContainerId -> IO Bool
    checkProvisionedFlag :: ContainerId -> IO Bool
    checkProvisionedFlag = ContainerName -> IO Bool
    doesFileExist (ContainerName -> IO Bool)
    -> (ContainerId -> ContainerName) -> ContainerId -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerId -> ContainerName
    provisionedFlag

    provisioningLock :: ContainerId -> FilePath
    provisioningLock :: ContainerId -> ContainerName
    provisioningLock ContainerId
    cid = ContainerName
    "docker" ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ".lock"

    shimdir :: ContainerId -> FilePath
    shimdir :: ContainerId -> ContainerName
    shimdir ContainerId
    cid = ContainerName
    "docker" ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ".shim"

    identFile :: ContainerId -> FilePath
    identFile :: ContainerId -> ContainerName
    identFile ContainerId
    cid = ContainerName
    "docker" ContainerName -> ContainerName -> ContainerName
    </> ContainerId -> ContainerName
    fromContainerId ContainerId
    cid ContainerName -> ContainerName -> ContainerName
    forall a. [a] -> [a] -> [a]
    ++ ContainerName
    ".ident"

    readIdentFile :: ContainerId -> IO ContainerIdent
    readIdentFile :: ContainerId -> IO ContainerIdent
    readIdentFile ContainerId
    cid = ContainerIdent -> Maybe ContainerIdent -> ContainerIdent
    forall a. a -> Maybe a -> a
    fromMaybe (ContainerName -> ContainerIdent
    forall a. HasCallStack => ContainerName -> a
    error ContainerName
    "bad ident in identFile")
    	(Maybe ContainerIdent -> ContainerIdent)
    -> (ContainerName -> Maybe ContainerIdent)
    -> ContainerName
    -> ContainerIdent
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContainerName -> Maybe ContainerIdent
    forall a. Read a => ContainerName -> Maybe a
    readish (ContainerName -> ContainerIdent)
    -> IO ContainerName -> IO ContainerIdent
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContainerName -> IO ContainerName
    readFile (ContainerId -> ContainerName
    identFile ContainerId
    cid)

    dockercmd :: String
    dockercmd :: ContainerName
    dockercmd = ContainerName
    "docker"

    report :: [Bool] -> Result
    report :: [Bool] -> Result
    report [Bool]
    rmed
    	| [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or [Bool]
    rmed = Result
    MadeChange
    	| Bool
    otherwise = Result
    NoChange