{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}
module Propellor.Property.Docker (
installed,
configured,
container,
docked,
imageBuilt,
imagePulled,
memoryLimited,
garbageCollected,
tweaked,
Image(..),
latestImage,
ContainerName,
Container(..),
HasImage(..),
dns,
hostname,
Publishable,
publish,
expose,
user,
Mountable,
volume,
volumes_from,
workdir,
memory,
cpuShares,
link,
environment,
ContainerAlias,
restartAlways,
restartOnFailure,
restartNever,
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 = [Package] -> Property DebianLike
Apt.installed ["docker.io"] Property DebianLike
-> Property ArchLinux
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
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` [Package] -> Property ArchLinux
Pacman.installed ["docker"]
configured :: Property (HasInfo + DebianLike)
configured :: Property (HasInfo + DebianLike)
configured = Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Property (HasInfo + DebianLike)
prop Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Property (DebianLike + ArchLinux)
installed
where
prop :: Property (HasInfo + DebianLike)
prop :: Property (HasInfo + DebianLike)
prop = PrivDataSource
-> Context
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property (HasInfo + DebianLike))
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property (HasInfo + DebianLike)
forall a b. (a -> b) -> a -> b
$ \getcfg :: (PrivData -> Propellor Result) -> Propellor Result
getcfg ->
Package
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes :: k).
SingI metatypes =>
Package
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' "docker configured" ((OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ \w :: 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
$ \cfg :: PrivData
cfg -> OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
"/root/.dockercfg" Package
-> [Package]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` PrivData -> [Package]
privDataLines PrivData
cfg
src :: PrivDataSource
src = PrivDataField -> Package -> Package -> PrivDataSource
PrivDataSourceFileFromCommand PrivDataField
DockerAuthentication
"/root/.dockercfg" "docker login"
type ContainerName = String
data Container = Container Image Host
instance IsContainer Container where
containerProperties :: Container -> [ChildProperty]
containerProperties (Container _ h :: Host
h) = Host -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties Host
h
containerInfo :: Container -> Info
containerInfo (Container _ h :: Host
h) = Host -> Info
forall c. IsContainer c => c -> Info
containerInfo Host
h
setContainerProperties :: Container -> [ChildProperty] -> Container
setContainerProperties (Container i :: Image
i h :: Host
h) ps :: [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 i :: Image
i _) = Image
i
container :: ContainerName -> Image -> Props metatypes -> Container
container :: Package -> Image -> Props metatypes -> Container
container cn :: Package
cn image :: Image
image (Props ps :: [ChildProperty]
ps) = Image -> Host -> Container
Container Image
image (Package -> [ChildProperty] -> Info -> Host
Host Package
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)
docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
docked :: Container
-> RevertableProperty
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
docked ctr :: Container
ctr@(Container _ h :: Host
h) =
(Container
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
propagateContainerInfo Container
ctr (Package
-> (ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go "docked" ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
setup))
Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> RevertableProperty
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
(Package
-> (ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go "undocked" ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
teardown)
where
cn :: Package
cn = Host -> Package
hostName Host
h
go :: Package
-> (ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go desc :: Package
desc a :: ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
a = Package
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (Package
desc Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ " " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
cn) ((OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \w :: OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w -> do
Package
hn <- (Host -> Package) -> Propellor Package
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> Package
hostName
let cid :: ContainerId
cid = Package -> Package -> ContainerId
ContainerId Package
hn Package
cn
OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$ ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
a ContainerId
cid (ContainerId -> Container -> ContainerInfo
mkContainerInfo ContainerId
cid Container
ctr)
setup :: ContainerId -> ContainerInfo -> Property Linux
setup :: ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
setup cid :: ContainerId
cid (ContainerInfo image :: Image
image runparams :: [Package]
runparams) =
ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
provisionContainer ContainerId
cid
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
ContainerId
-> Image
-> [Package]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runningContainer ContainerId
cid Image
image [Package]
runparams
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Property (DebianLike + ArchLinux)
installed
teardown :: ContainerId -> ContainerInfo -> Property Linux
teardown :: ContainerId
-> ContainerInfo
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
teardown cid :: ContainerId
cid (ContainerInfo image :: Image
image _runparams :: [Package]
_runparams) =
Package
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ("undocked " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ContainerId -> Package
fromContainerId ContainerId
cid) (Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ [Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])]
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps
[ ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
stoppedContainer ContainerId
cid
, Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property ("cleaned up " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ContainerId -> Package
fromContainerId ContainerId
cid) (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
IO Result -> Propellor Result
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)
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
]
]
imageBuilt :: HasImage c => FilePath -> c -> Property Linux
imageBuilt :: Package
-> c
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
imageBuilt directory :: Package
directory ctr :: c
ctr = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Package
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall p. IsProp p => p -> Package -> p
`describe` Package
msg
where
msg :: Package
msg = "docker image " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ (Image -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier Image
image) Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ " built from " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
directory
built :: Property Linux
built :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
Package
-> [Package]
-> (CreateProcess -> CreateProcess)
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Cmd.cmdProperty' Package
dockercmd ["build", "--tag", Image -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier Image
image, "./"] CreateProcess -> CreateProcess
workDir
UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
workDir :: CreateProcess -> CreateProcess
workDir p :: CreateProcess
p = CreateProcess
p { cwd :: Maybe Package
cwd = Package -> Maybe Package
forall a. a -> Maybe a
Just Package
directory }
image :: Image
image = c -> Image
forall a. HasImage a => a -> Image
getImageName c
ctr
imagePulled :: HasImage c => c -> Property Linux
imagePulled :: c
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
imagePulled ctr :: c
ctr = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
pulled Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Package
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall p. IsProp p => p -> Package -> p
`describe` Package
msg
where
msg :: Package
msg = "docker image " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ (Image -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier Image
image) Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ " pulled"
pulled :: Property Linux
pulled :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
pulled = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
Package
-> [Package]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Cmd.cmdProperty Package
dockercmd ["pull", Image -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier Image
image]
UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
propagateContainerInfo ctr :: Container
ctr@(Container _ h :: Host
h) p :: Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
p =
Package
-> Container
-> (PropagateInfo -> Bool)
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall metatypes c.
(IncludesInfo metatypes ~ 'True, IsContainer c) =>
Package
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer Package
cn Container
ctr PropagateInfo -> Bool
normalContainerInfo (Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
p Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Info
-> Property
(Sing
'[ '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 Package Host
_dockerContainers = Package -> Host -> Map Package Host
forall k a. k -> a -> Map k a
M.singleton Package
cn Host
h }
cn :: Package
cn = Host -> Package
hostName Host
h
mkContainerInfo :: ContainerId -> Container -> ContainerInfo
mkContainerInfo :: ContainerId -> Container -> ContainerInfo
mkContainerInfo cid :: ContainerId
cid@(ContainerId hn :: Package
hn _cn :: Package
_cn) (Container img :: Image
img h :: Host
h) =
Image -> [Package] -> ContainerInfo
ContainerInfo Image
img [Package]
runparams
where
runparams :: [Package]
runparams = (DockerRunParam -> Package) -> [DockerRunParam] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map (\(DockerRunParam mkparam :: Package -> Package
mkparam) -> Package -> Package
mkparam Package
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
('WithInfo
: Concat
'[]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Host
forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps Host
h (Props
(MetaTypes
('WithInfo
: Concat
'[]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Host)
-> Props
(MetaTypes
('WithInfo
: Concat
'[]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Host
forall a b. (a -> b) -> a -> b
$ Host
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c.
IsContainer c =>
c
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
containerProps Host
h
Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Props
(MetaTypes
(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
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
restartAlways
Props
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Props
(MetaTypes
(Combine
'[ '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))
& Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall v.
Mountable v =>
v
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
volume (Package
localdirPackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++":"Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
localdir)
Props
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Props
(MetaTypes
(Combine
'[ '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))
& Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
name (ContainerId -> Package
fromContainerId ContainerId
cid)
garbageCollected :: Property Linux
garbageCollected :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
garbageCollected = Package
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList "docker garbage collected" (Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
gccontainers
Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
gcimages
where
gccontainers :: Property Linux
gccontainers :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
gccontainers = Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property "docker containers garbage collected" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
IO Result -> Propellor Result
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)
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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
gcimages = Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property "docker images garbage collected" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
IO Result -> Propellor Result
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)
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)
tweaked :: Property Linux
tweaked :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
tweaked = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> [Package]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty "sh"
[ "-c"
, "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"
]
UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Package
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> Package -> p
`describe` "tweaked for docker"
memoryLimited :: Property DebianLike
memoryLimited :: Property DebianLike
memoryLimited = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$
"/etc/default/grub" Package
-> Package
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.containsLine` Package
cfg
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Package
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> Package -> p
`describe` "docker memory limited"
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (Package
-> [Package]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty "update-grub" [] UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange)
where
cmdline :: Package
cmdline = "cgroup_enable=memory swapaccount=1"
cfg :: Package
cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
cmdlinePackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++"\""
data ContainerInfo = ContainerInfo Image [RunParam]
type RunParam = String
newtype ImageID = ImageID String
class ImageIdentifier i where
toImageID :: i -> ImageID
toImageID = Package -> ImageID
ImageID (Package -> ImageID) -> (i -> Package) -> i -> ImageID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier
imageIdentifier :: i -> String
instance ImageIdentifier ImageID where
imageIdentifier :: ImageID -> Package
imageIdentifier (ImageID i :: Package
i) = Package
i
toImageID :: ImageID -> ImageID
toImageID = ImageID -> ImageID
forall a. a -> a
id
data Image = Image
{ Image -> Package
repository :: String
, Image -> Maybe Package
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
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: 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
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Read, Int -> Image -> Package -> Package
[Image] -> Package -> Package
Image -> Package
(Int -> Image -> Package -> Package)
-> (Image -> Package)
-> ([Image] -> Package -> Package)
-> Show Image
forall a.
(Int -> a -> Package -> Package)
-> (a -> Package) -> ([a] -> Package -> Package) -> Show a
showList :: [Image] -> Package -> Package
$cshowList :: [Image] -> Package -> Package
show :: Image -> Package
$cshow :: Image -> Package
showsPrec :: Int -> Image -> Package -> Package
$cshowsPrec :: Int -> Image -> Package -> Package
Show)
latestImage :: String -> Image
latestImage :: Package -> Image
latestImage repo :: Package
repo = Package -> Maybe Package -> Image
Image Package
repo Maybe Package
forall a. Maybe a
Nothing
instance ImageIdentifier Image where
imageIdentifier :: Image -> Package
imageIdentifier i :: Image
i = Image -> Package
repository Image
i Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ (Package -> (Package -> Package) -> Maybe Package -> Package
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Package -> Package -> Package
forall a. [a] -> [a] -> [a]
(++) ":") (Maybe Package -> Package) -> Maybe Package -> Package
forall a b. (a -> b) -> a -> b
$ Image -> Maybe Package
tag Image
i)
newtype ImageUID = ImageUID String
instance ImageIdentifier ImageUID where
imageIdentifier :: ImageUID -> Package
imageIdentifier (ImageUID uid :: Package
uid) = Package
uid
dns :: String -> Property (HasInfo + Linux)
dns :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
dns = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "dns"
hostname :: String -> Property (HasInfo + Linux)
hostname :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
hostname = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "hostname"
name :: String -> Property (HasInfo + Linux)
name :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
name = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "name"
class Publishable p where
toPublish :: p -> String
instance Publishable (Bound Port) where
toPublish :: Bound Port -> Package
toPublish p :: Bound Port
p = Port -> Package
forall t. ConfigurableValue t => t -> Package
val (Bound Port -> Port
forall v. Bound v -> v
hostSide Bound Port
p) Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Port -> Package
forall t. ConfigurableValue t => t -> Package
val (Bound Port -> Port
forall v. Bound v -> v
containerSide Bound Port
p)
instance Publishable String where
toPublish :: Package -> Package
toPublish = Package -> Package
forall a. a -> a
id
publish :: Publishable p => p -> Property (HasInfo + Linux)
publish :: p
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
publish = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "publish" (Package
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (p -> Package)
-> p
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Package
forall p. Publishable p => p -> Package
toPublish
expose :: String -> Property (HasInfo + Linux)
expose :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
expose = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "expose"
user :: String -> Property (HasInfo + Linux)
user :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
user = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "user"
class Mountable p where
toMount :: p -> String
instance Mountable (Bound FilePath) where
toMount :: Bound Package -> Package
toMount p :: Bound Package
p = Bound Package -> Package
forall v. Bound v -> v
hostSide Bound Package
p Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Bound Package -> Package
forall v. Bound v -> v
containerSide Bound Package
p
instance Mountable String where
toMount :: Package -> Package
toMount = Package -> Package
forall a. a -> a
id
volume :: Mountable v => v -> Property (HasInfo + Linux)
volume :: v
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
volume = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "volume" (Package
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (v -> Package)
-> v
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Package
forall p. Mountable p => p -> Package
toMount
volumes_from :: ContainerName -> Property (HasInfo + Linux)
volumes_from :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
volumes_from cn :: Package
cn = Package
-> (Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
genProp "volumes-from" ((Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \hn :: Package
hn ->
ContainerId -> Package
fromContainerId (Package -> Package -> ContainerId
ContainerId Package
hn Package
cn)
workdir :: String -> Property (HasInfo + Linux)
workdir :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
workdir = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "workdir"
memory :: String -> Property (HasInfo + Linux)
memory :: Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
memory = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "memory"
cpuShares :: Int -> Property (HasInfo + Linux)
cpuShares :: Int
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
cpuShares = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "cpu-shares" (Package
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (Int -> Package)
-> Int
-> Property
(Sing
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Package
forall a. Show a => a -> Package
show
link :: ContainerName -> ContainerAlias -> Property (HasInfo + Linux)
link :: Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
link linkwith :: Package
linkwith calias :: Package
calias = Package
-> (Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
genProp "link" ((Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \hn :: Package
hn ->
ContainerId -> Package
fromContainerId (Package -> Package -> ContainerId
ContainerId Package
hn Package
linkwith) Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
calias
type ContainerAlias = String
restartAlways :: Property (HasInfo + Linux)
restartAlways :: Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
restartAlways = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "restart" "always"
restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
restartOnFailure :: Maybe Int
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
restartOnFailure Nothing = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "restart" "on-failure"
restartOnFailure (Just n :: Int
n) = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "restart" ("on-failure:" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Int -> Package
forall a. Show a => a -> Package
show Int
n)
restartNever :: Property (HasInfo + Linux)
restartNever :: Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
restartNever = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "restart" "no"
environment :: (String, String) -> Property (HasInfo + Linux)
environment :: (Package, Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
environment (k :: Package
k, v :: Package
v) = Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp "env" (Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
k Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ "=" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
v
data ContainerId = ContainerId
{ ContainerId -> Package
containerHostName :: HostName
, ContainerId -> Package
containerName :: ContainerName
}
deriving (ContainerId -> ContainerId -> Bool
(ContainerId -> ContainerId -> Bool)
-> (ContainerId -> ContainerId -> Bool) -> Eq ContainerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerId -> ContainerId -> Bool
$c/= :: ContainerId -> ContainerId -> Bool
== :: ContainerId -> ContainerId -> Bool
$c== :: 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
readListPrec :: ReadPrec [ContainerId]
$creadListPrec :: ReadPrec [ContainerId]
readPrec :: ReadPrec ContainerId
$creadPrec :: ReadPrec ContainerId
readList :: ReadS [ContainerId]
$creadList :: ReadS [ContainerId]
readsPrec :: Int -> ReadS ContainerId
$creadsPrec :: Int -> ReadS ContainerId
Read, Int -> ContainerId -> Package -> Package
[ContainerId] -> Package -> Package
ContainerId -> Package
(Int -> ContainerId -> Package -> Package)
-> (ContainerId -> Package)
-> ([ContainerId] -> Package -> Package)
-> Show ContainerId
forall a.
(Int -> a -> Package -> Package)
-> (a -> Package) -> ([a] -> Package -> Package) -> Show a
showList :: [ContainerId] -> Package -> Package
$cshowList :: [ContainerId] -> Package -> Package
show :: ContainerId -> Package
$cshow :: ContainerId -> Package
showsPrec :: Int -> ContainerId -> Package -> Package
$cshowsPrec :: Int -> ContainerId -> Package -> Package
Show)
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
readListPrec :: ReadPrec [ContainerIdent]
$creadListPrec :: ReadPrec [ContainerIdent]
readPrec :: ReadPrec ContainerIdent
$creadPrec :: ReadPrec ContainerIdent
readList :: ReadS [ContainerIdent]
$creadList :: ReadS [ContainerIdent]
readsPrec :: Int -> ReadS ContainerIdent
$creadsPrec :: Int -> ReadS ContainerIdent
Read, Int -> ContainerIdent -> Package -> Package
[ContainerIdent] -> Package -> Package
ContainerIdent -> Package
(Int -> ContainerIdent -> Package -> Package)
-> (ContainerIdent -> Package)
-> ([ContainerIdent] -> Package -> Package)
-> Show ContainerIdent
forall a.
(Int -> a -> Package -> Package)
-> (a -> Package) -> ([a] -> Package -> Package) -> Show a
showList :: [ContainerIdent] -> Package -> Package
$cshowList :: [ContainerIdent] -> Package -> Package
show :: ContainerIdent -> Package
$cshow :: ContainerIdent -> Package
showsPrec :: Int -> ContainerIdent -> Package -> Package
$cshowsPrec :: Int -> ContainerIdent -> Package -> Package
Show, ContainerIdent -> ContainerIdent -> Bool
(ContainerIdent -> ContainerIdent -> Bool)
-> (ContainerIdent -> ContainerIdent -> Bool) -> Eq ContainerIdent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerIdent -> ContainerIdent -> Bool
$c/= :: ContainerIdent -> ContainerIdent -> Bool
== :: ContainerIdent -> ContainerIdent -> Bool
$c== :: ContainerIdent -> ContainerIdent -> Bool
Eq)
toContainerId :: String -> Maybe ContainerId
toContainerId :: Package -> Maybe ContainerId
toContainerId s :: Package
s
| Package
myContainerSuffix Package -> Package -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Package
s = case (Char -> Bool) -> Package -> (Package, Package)
forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') (Package -> Package
forall a. [a] -> [a]
desuffix Package
s) of
(cn :: Package
cn, hn :: Package
hn)
| Package -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Package
hn Bool -> Bool -> Bool
|| Package -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Package
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
$ Package -> Package -> ContainerId
ContainerId Package
hn Package
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 = Package -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Package
myContainerSuffix
fromContainerId :: ContainerId -> String
fromContainerId :: ContainerId -> Package
fromContainerId (ContainerId hn :: Package
hn cn :: Package
cn) = Package
cnPackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++"."Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
hnPackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
myContainerSuffix
myContainerSuffix :: String
myContainerSuffix :: Package
myContainerSuffix = ".propellor"
containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
containerDesc :: ContainerId -> Property i -> Property i
containerDesc cid :: ContainerId
cid p :: Property i
p = Property i
p Property i -> Package -> Property i
forall p. IsProp p => p -> Package -> p
`describe` Package
desc
where
desc :: Package
desc = "container " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ContainerId -> Package
fromContainerId ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ " " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Property i -> Package
forall p. IsProp p => p -> Package
getDesc Property i
p
runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
runningContainer :: ContainerId
-> Image
-> [Package]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runningContainer cid :: ContainerId
cid@(ContainerId hn :: Package
hn cn :: Package
cn) image :: Image
image runps :: [Package]
runps = ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall i.
IsProp (Property i) =>
ContainerId -> Property i -> Property i
containerDesc ContainerId
cid (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property "running" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ do
[ContainerId]
l <- IO [ContainerId] -> Propellor [ContainerId]
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ContainerId]
l
then Either Package (Maybe ContainerIdent) -> Propellor Result
checkident (Either Package (Maybe ContainerIdent) -> Propellor Result)
-> Propellor (Either Package (Maybe ContainerIdent))
-> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Package (Maybe ContainerIdent))
-> Propellor (Either Package (Maybe ContainerIdent))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either Package (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 (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 (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
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 (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
Either Package (Maybe ContainerIdent) -> Propellor Result
checkident (Either Package (Maybe ContainerIdent) -> Propellor Result)
-> Propellor (Either Package (Maybe ContainerIdent))
-> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Package (Maybe ContainerIdent))
-> Propellor (Either Package (Maybe ContainerIdent))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int
-> IO (Either Package (Maybe ContainerIdent))
-> IO (Either Package (Maybe ContainerIdent))
forall e a.
Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
retry 60 (IO (Either Package (Maybe ContainerIdent))
-> IO (Either Package (Maybe ContainerIdent)))
-> IO (Either Package (Maybe ContainerIdent))
-> IO (Either Package (Maybe ContainerIdent))
forall a b. (a -> b) -> a -> b
$ IO (Either Package (Maybe ContainerIdent))
getrunningident)
, Image -> Propellor Result
forall i. ImageIdentifier i => i -> Propellor Result
go Image
image
)
where
ident :: ContainerIdent
ident = Image -> Package -> Package -> [Package] -> ContainerIdent
ContainerIdent Image
image Package
hn Package
cn [Package]
runps
checkident :: Either Package (Maybe ContainerIdent) -> Propellor Result
checkident (Right runningident :: 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 (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 errmsg :: Package
errmsg) = do
Package -> Propellor ()
forall (m :: * -> *). MonadIO m => Package -> m ()
warningMessage Package
errmsg
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
restartcontainer :: Propellor Result
restartcontainer = do
ImageID
oldimage <- IO ImageID -> Propellor ImageID
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 (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 Package (Maybe ContainerIdent))
getrunningident = Package
-> (Package
-> Handle -> IO (Either Package (Maybe ContainerIdent)))
-> IO (Either Package (Maybe ContainerIdent))
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Package -> (Package -> Handle -> m a) -> m a
withTmpFile "dockerrunsane" ((Package -> Handle -> IO (Either Package (Maybe ContainerIdent)))
-> IO (Either Package (Maybe ContainerIdent)))
-> (Package
-> Handle -> IO (Either Package (Maybe ContainerIdent)))
-> IO (Either Package (Maybe ContainerIdent))
forall a b. (a -> b) -> a -> b
$ \t :: Package
t h :: Handle
h -> do
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 -> [Package] -> [Package] -> CreateProcess
inContainerProcess ContainerId
cid []
["rm", "-f", Package
t])
IO Bool
-> (IO (Either Package (Maybe ContainerIdent)),
IO (Either Package (Maybe ContainerIdent)))
-> IO (Either Package (Maybe ContainerIdent))
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (Package -> IO Bool
doesFileExist Package
t)
( Maybe ContainerIdent -> Either Package (Maybe ContainerIdent)
forall a b. b -> Either a b
Right (Maybe ContainerIdent -> Either Package (Maybe ContainerIdent))
-> (Package -> Maybe ContainerIdent)
-> Package
-> Either Package (Maybe ContainerIdent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Maybe ContainerIdent
forall a. Read a => Package -> Maybe a
readish (Package -> Either Package (Maybe ContainerIdent))
-> IO Package -> IO (Either Package (Maybe ContainerIdent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
CreateProcess -> IO Package
readProcess' (ContainerId -> [Package] -> [Package] -> CreateProcess
inContainerProcess ContainerId
cid []
["cat", Package
propellorIdent])
, Either Package (Maybe ContainerIdent)
-> IO (Either Package (Maybe ContainerIdent))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Package (Maybe ContainerIdent)
-> IO (Either Package (Maybe ContainerIdent)))
-> Either Package (Maybe ContainerIdent)
-> IO (Either Package (Maybe ContainerIdent))
forall a b. (a -> b) -> a -> b
$ Package -> Either Package (Maybe ContainerIdent)
forall a b. a -> Either a b
Left "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 :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
retry 0 _ = Either e (Maybe a) -> IO (Either e (Maybe 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 n :: Int
n a :: 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 Nothing -> do
Seconds -> IO ()
threadDelaySeconds (Int -> Seconds
Seconds 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
-1) IO (Either e (Maybe a))
a
_ -> Either e (Maybe a) -> IO (Either e (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return Either e (Maybe a)
v
go :: ImageIdentifier i => i -> Propellor Result
go :: i -> Propellor Result
go img :: i
img = IO Result -> Propellor Result
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 -> Package -> IO ()
createDirectoryIfMissing Bool
True (Package -> Package
takeDirectory (Package -> Package) -> Package -> Package
forall a b. (a -> b) -> a -> b
$ ContainerId -> Package
identFile ContainerId
cid)
Package
shim <- Package -> Maybe Package -> Package -> IO Package
Shim.setup (Package
localdir Package -> Package -> Package
</> "propellor") Maybe Package
forall a. Maybe a
Nothing (Package
localdir Package -> Package -> Package
</> ContainerId -> Package
shimdir ContainerId
cid)
Package -> Package -> IO ()
writeFile (ContainerId -> Package
identFile ContainerId
cid) (ContainerIdent -> Package
forall a. Show a => a -> Package
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 -> [Package] -> [Package] -> IO Bool
forall i.
ImageIdentifier i =>
i -> [Package] -> [Package] -> IO Bool
runContainer i
img
([Package]
runps [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ ["-i", "-d", "-t"])
[Package
shim, "--continue", CmdLine -> Package
forall a. Show a => a -> Package
show (Package -> CmdLine
DockerInit (ContainerId -> Package
fromContainerId ContainerId
cid))]
init :: String -> IO ()
init :: Package -> IO ()
init s :: Package
s = case Package -> Maybe ContainerId
toContainerId Package
s of
Nothing -> Package -> IO ()
forall a. HasCallStack => Package -> a
error (Package -> IO ()) -> Package -> IO ()
forall a b. (a -> b) -> a -> b
$ "Invalid ContainerId: " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
s
Just cid :: ContainerId
cid -> do
Package -> IO ()
changeWorkingDirectory Package
localdir
Package -> Package -> IO ()
writeFile Package
propellorIdent (Package -> IO ())
-> (ContainerIdent -> Package) -> ContainerIdent -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContainerIdent -> Package
forall a. Show a => a -> Package
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 :: Package
shim = Package -> Package -> Package
Shim.file (Package
localdir Package -> Package -> Package
</> "propellor") (Package
localdir Package -> Package -> Package
</> ContainerId -> Package
shimdir ContainerId
cid)
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Package -> [CommandParam] -> IO Bool
boolSystem Package
shim [Package -> CommandParam
Param "--continue", Package -> CommandParam
Param (Package -> CommandParam) -> Package -> CommandParam
forall a b. (a -> b) -> a -> b
$ CmdLine -> Package
forall a. Show a => a -> Package
show (CmdLine -> Package) -> CmdLine -> Package
forall a b. (a -> b) -> a -> b
$ ContainerId -> CmdLine
toChain ContainerId
cid]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Package -> IO ()
forall (m :: * -> *). MonadIO m => Package -> m ()
warningMessage "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 (Package -> IO Bool
inPath "bash")
( Package -> [CommandParam] -> IO Bool
boolSystem "bash" [Package -> CommandParam
Param "-l"]
, Package -> [CommandParam] -> IO Bool
boolSystem "/bin/sh" []
)
Package -> IO ()
putStrLn "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
provisionContainer :: ContainerId -> Property Linux
provisionContainer :: ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
provisionContainer cid :: ContainerId
cid = ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall i.
IsProp (Property i) =>
ContainerId -> Property i -> Property i
containerDesc ContainerId
cid (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property "provisioned" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
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 :: Package
shim = Package -> Package -> Package
Shim.file (Package
localdir Package -> Package -> Package
</> "propellor") (Package
localdir Package -> Package -> Package
</> ContainerId -> Package
shimdir ContainerId
cid)
let params :: [Package]
params = ["--continue", CmdLine -> Package
forall a. Show a => a -> Package
show (CmdLine -> Package) -> CmdLine -> Package
forall a b. (a -> b) -> a -> b
$ ContainerId -> CmdLine
toChain ContainerId
cid]
MessageHandle
msgh <- IO MessageHandle
getMessageHandle
let p :: CreateProcess
p = ContainerId -> [Package] -> [Package] -> CreateProcess
inContainerProcess ContainerId
cid
(if MessageHandle -> Bool
isConsole MessageHandle
msgh then ["-it"] else [])
(Package
shim Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: [Package]
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 (m :: * -> *) a. Monad m => a -> m a
return Result
r
toChain :: ContainerId -> CmdLine
toChain :: ContainerId -> CmdLine
toChain cid :: ContainerId
cid = Package -> Package -> CmdLine
DockerChain (ContainerId -> Package
containerHostName ContainerId
cid) (ContainerId -> Package
fromContainerId ContainerId
cid)
chain :: [Host] -> HostName -> String -> IO ()
chain :: [Host] -> Package -> Package -> IO ()
chain hostlist :: [Host]
hostlist hn :: Package
hn s :: Package
s = case Package -> Maybe ContainerId
toContainerId Package
s of
Nothing -> Package -> IO ()
forall (m :: * -> *) a. MonadIO m => Package -> m a
errorMessage "bad container id"
Just cid :: ContainerId
cid -> case [Host] -> Package -> Maybe Host
findHostNoAlias [Host]
hostlist Package
hn of
Nothing -> Package -> IO ()
forall (m :: * -> *) a. MonadIO m => Package -> m a
errorMessage ("cannot find host " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
hn)
Just parenthost :: Host
parenthost -> case Package -> Map Package Host -> Maybe Host
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ContainerId -> Package
containerName ContainerId
cid) (DockerInfo -> Map Package Host
_dockerContainers (DockerInfo -> Map Package Host) -> DockerInfo -> Map Package 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
Nothing -> Package -> IO ()
forall (m :: * -> *) a. MonadIO m => Package -> m a
errorMessage ("cannot find container " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ContainerId -> Package
containerName ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ " docked on host " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
hn)
Just h :: Host
h -> ContainerId -> Host -> IO ()
go ContainerId
cid Host
h
where
go :: ContainerId -> Host -> IO ()
go cid :: ContainerId
cid h :: Host
h = do
Package -> IO ()
changeWorkingDirectory Package
localdir
Package -> IO () -> IO ()
forall a. Package -> IO a -> IO a
onlyProcess (ContainerId -> Package
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 h :: 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 cid :: ContainerId
cid = Package -> [CommandParam] -> IO Bool
boolSystem Package
dockercmd [Package -> CommandParam
Param "stop", Package -> CommandParam
Param (Package -> CommandParam) -> Package -> CommandParam
forall a b. (a -> b) -> a -> b
$ ContainerId -> Package
fromContainerId ContainerId
cid ]
startContainer :: ContainerId -> IO Bool
startContainer :: ContainerId -> IO Bool
startContainer cid :: ContainerId
cid = Package -> [CommandParam] -> IO Bool
boolSystem Package
dockercmd [Package -> CommandParam
Param "start", Package -> CommandParam
Param (Package -> CommandParam) -> Package -> CommandParam
forall a b. (a -> b) -> a -> b
$ ContainerId -> Package
fromContainerId ContainerId
cid ]
stoppedContainer :: ContainerId -> Property Linux
stoppedContainer :: ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
stoppedContainer cid :: ContainerId
cid = ContainerId
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall i.
IsProp (Property i) =>
ContainerId -> Property i -> Property i
containerDesc ContainerId
cid (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Package
desc ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ \w :: 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 (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 (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 (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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
stop
, Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
)
where
desc :: Package
desc = "stopped"
stop :: Property Linux
stop :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
stop = Package
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property Package
desc (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
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
Package -> IO ()
nukeFile (Package -> IO ()) -> Package -> IO ()
forall a b. (a -> b) -> a -> b
$ ContainerId -> Package
identFile ContainerId
cid
Package -> IO ()
removeDirectoryRecursive (Package -> IO ()) -> Package -> IO ()
forall a b. (a -> b) -> a -> b
$ ContainerId -> Package
shimdir ContainerId
cid
ContainerId -> IO ()
clearProvisionedFlag ContainerId
cid
removeContainer :: ContainerId -> IO Bool
removeContainer :: ContainerId -> IO Bool
removeContainer cid :: 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
$
(Package, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Package, Bool) -> Bool) -> IO (Package, Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
processTranscript Package
dockercmd ["rm", ContainerId -> Package
fromContainerId ContainerId
cid ] Maybe Package
forall a. Maybe a
Nothing
removeImage :: ImageIdentifier i => i -> IO Bool
removeImage :: i -> IO Bool
removeImage image :: 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
$
(Package, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Package, Bool) -> Bool) -> IO (Package, Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
processTranscript Package
dockercmd ["rmi", i -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier i
image] Maybe Package
forall a. Maybe a
Nothing
runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool
runContainer :: i -> [Package] -> [Package] -> IO Bool
runContainer image :: i
image ps :: [Package]
ps cmd :: [Package]
cmd = Package -> [CommandParam] -> IO Bool
boolSystem Package
dockercmd ([CommandParam] -> IO Bool) -> [CommandParam] -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Package -> CommandParam) -> [Package] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map Package -> CommandParam
Param ([Package] -> [CommandParam]) -> [Package] -> [CommandParam]
forall a b. (a -> b) -> a -> b
$
"run" Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: ([Package]
ps [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ (i -> Package
forall i. ImageIdentifier i => i -> Package
imageIdentifier i
image) Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: [Package]
cmd)
inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
inContainerProcess :: ContainerId -> [Package] -> [Package] -> CreateProcess
inContainerProcess cid :: ContainerId
cid ps :: [Package]
ps cmd :: [Package]
cmd = Package -> [Package] -> CreateProcess
proc Package
dockercmd ("exec" Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: [Package]
ps [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [ContainerId -> Package
fromContainerId ContainerId
cid] [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package]
cmd)
commitContainer :: ContainerId -> IO (Maybe ImageUID)
commitContainer :: ContainerId -> IO (Maybe ImageUID)
commitContainer cid :: 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
$
Package -> ImageUID
ImageUID (Package -> ImageUID)
-> (Package -> Package) -> Package -> ImageUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Package -> Package
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')
(Package -> ImageUID) -> IO Package -> IO ImageUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> IO Package
readProcess Package
dockercmd ["commit", ContainerId -> Package
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
/= :: ContainerFilter -> ContainerFilter -> Bool
$c/= :: ContainerFilter -> ContainerFilter -> Bool
== :: ContainerFilter -> ContainerFilter -> Bool
$c== :: ContainerFilter -> ContainerFilter -> Bool
Eq)
listContainers :: ContainerFilter -> IO [ContainerId]
listContainers :: ContainerFilter -> IO [ContainerId]
listContainers status :: ContainerFilter
status =
(Package -> Maybe ContainerId) -> [Package] -> [ContainerId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Package -> Maybe ContainerId
toContainerId ([Package] -> [ContainerId])
-> (Package -> [Package]) -> Package -> [ContainerId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package -> [Package]) -> [Package] -> [Package]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Package -> Package -> [Package]
forall a. Eq a => [a] -> [a] -> [[a]]
split ",")
([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package -> Maybe Package) -> [Package] -> [Package]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Package] -> Maybe Package
forall a. [a] -> Maybe a
lastMaybe ([Package] -> Maybe Package)
-> (Package -> [Package]) -> Package -> Maybe Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
words) ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
lines
(Package -> [ContainerId]) -> IO Package -> IO [ContainerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> IO Package
readProcess Package
dockercmd [Package]
ps
where
ps :: [Package]
ps
| ContainerFilter
status ContainerFilter -> ContainerFilter -> Bool
forall a. Eq a => a -> a -> Bool
== ContainerFilter
AllContainers = [Package]
baseps [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ ["--all"]
| Bool
otherwise = [Package]
baseps
baseps :: [Package]
baseps = ["ps", "--no-trunc"]
listImages :: IO [ImageUID]
listImages :: IO [ImageUID]
listImages = (Package -> ImageUID) -> [Package] -> [ImageUID]
forall a b. (a -> b) -> [a] -> [b]
map Package -> ImageUID
ImageUID ([Package] -> [ImageUID])
-> (Package -> [Package]) -> Package -> [ImageUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
lines (Package -> [ImageUID]) -> IO Package -> IO [ImageUID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> IO Package
readProcess Package
dockercmd ["images", "--all", "--quiet"]
runProp :: String -> RunParam -> Property (HasInfo + Linux)
runProp :: Package
-> Package
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
runProp field :: Package
field v :: Package
v = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
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
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> DockerInfo
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall v.
IsInfo v =>
Package
-> v
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty (Package
param) (DockerInfo
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> DockerInfo
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
DockerInfo
forall a. Monoid a => a
mempty { _dockerRunParams :: [DockerRunParam]
_dockerRunParams = [(Package -> Package) -> DockerRunParam
DockerRunParam (\_ -> "--"Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
param)] }
where
param :: Package
param = Package
fieldPackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++"="Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
v
genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux)
genProp :: Package
-> (Package -> Package)
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
genProp field :: Package
field mkval :: Package -> Package
mkval = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
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
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ Package
-> DockerInfo
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall v.
IsInfo v =>
Package
-> v
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty Package
field (DockerInfo
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> DockerInfo
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
DockerInfo
forall a. Monoid a => a
mempty { _dockerRunParams :: [DockerRunParam]
_dockerRunParams = [(Package -> Package) -> DockerRunParam
DockerRunParam (\hn :: Package
hn -> "--"Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
fieldPackage -> Package -> Package
forall a. [a] -> [a] -> [a]
++"=" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package -> Package
mkval Package
hn)] }
dockerInfo :: DockerInfo -> Info
dockerInfo :: DockerInfo -> Info
dockerInfo i :: DockerInfo
i = Info
forall a. Monoid a => a
mempty Info -> DockerInfo -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` DockerInfo
i
propellorIdent :: FilePath
propellorIdent :: Package
propellorIdent = "/.propellor-ident"
provisionedFlag :: ContainerId -> FilePath
provisionedFlag :: ContainerId -> Package
provisionedFlag cid :: ContainerId
cid = "docker" Package -> Package -> Package
</> ContainerId -> Package
fromContainerId ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ".provisioned"
clearProvisionedFlag :: ContainerId -> IO ()
clearProvisionedFlag :: ContainerId -> IO ()
clearProvisionedFlag = Package -> IO ()
nukeFile (Package -> IO ())
-> (ContainerId -> Package) -> ContainerId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContainerId -> Package
provisionedFlag
setProvisionedFlag :: ContainerId -> IO ()
setProvisionedFlag :: ContainerId -> IO ()
setProvisionedFlag cid :: ContainerId
cid = do
Bool -> Package -> IO ()
createDirectoryIfMissing Bool
True (Package -> Package
takeDirectory (ContainerId -> Package
provisionedFlag ContainerId
cid))
Package -> Package -> IO ()
writeFile (ContainerId -> Package
provisionedFlag ContainerId
cid) "1"
checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag = Package -> IO Bool
doesFileExist (Package -> IO Bool)
-> (ContainerId -> Package) -> ContainerId -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContainerId -> Package
provisionedFlag
provisioningLock :: ContainerId -> FilePath
provisioningLock :: ContainerId -> Package
provisioningLock cid :: ContainerId
cid = "docker" Package -> Package -> Package
</> ContainerId -> Package
fromContainerId ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ".lock"
shimdir :: ContainerId -> FilePath
shimdir :: ContainerId -> Package
shimdir cid :: ContainerId
cid = "docker" Package -> Package -> Package
</> ContainerId -> Package
fromContainerId ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ".shim"
identFile :: ContainerId -> FilePath
identFile :: ContainerId -> Package
identFile cid :: ContainerId
cid = "docker" Package -> Package -> Package
</> ContainerId -> Package
fromContainerId ContainerId
cid Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ ".ident"
readIdentFile :: ContainerId -> IO ContainerIdent
readIdentFile :: ContainerId -> IO ContainerIdent
readIdentFile cid :: ContainerId
cid = ContainerIdent -> Maybe ContainerIdent -> ContainerIdent
forall a. a -> Maybe a -> a
fromMaybe (Package -> ContainerIdent
forall a. HasCallStack => Package -> a
error "bad ident in identFile")
(Maybe ContainerIdent -> ContainerIdent)
-> (Package -> Maybe ContainerIdent) -> Package -> ContainerIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Maybe ContainerIdent
forall a. Read a => Package -> Maybe a
readish (Package -> ContainerIdent) -> IO Package -> IO ContainerIdent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> IO Package
readFile (ContainerId -> Package
identFile ContainerId
cid)
dockercmd :: String
dockercmd :: Package
dockercmd = "docker"
report :: [Bool] -> Result
report :: [Bool] -> Result
report rmed :: [Bool]
rmed
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
rmed = Result
MadeChange
| Bool
otherwise = Result
NoChange