{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}

module Propellor.Property.Chroot (
	debootstrapped,
	bootstrapped,
	provisioned,
	hostChroot,
	Chroot(..),
	ChrootBootstrapper(..),
	Debootstrapped(..),
	ChrootTarball(..),
	exposeTrueLocaldir,
	useHostProxy,
	-- * Internal use
	provisioned',
	propagateChrootInfo,
	propellChroot,
	chain,
	chrootSystem,
) where

import Propellor.Base
import Propellor.Container
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Container
import Propellor.Types.Info
import Propellor.Types.Core
import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Systemd.Core as Systemd
import qualified Propellor.Property.File as File
import qualified Propellor.Shim as Shim
import Propellor.Property.Mount
import Utility.Split

import qualified Data.Map as M
import System.Posix.Directory

-- | Specification of a chroot. Normally you'll use `debootstrapped` or
-- `bootstrapped` or `hostChroot` to construct a Chroot value.
data Chroot where
	Chroot :: ChrootBootstrapper b => FilePath -> b -> InfoPropagator -> Host -> Chroot

instance IsContainer Chroot where
	containerProperties :: Chroot -> [ChildProperty]
containerProperties (Chroot FilePath
_ b
_ InfoPropagator
_ Host
h) = Host -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties Host
h
	containerInfo :: Chroot -> Info
containerInfo (Chroot FilePath
_ b
_ InfoPropagator
_ Host
h) = Host -> Info
forall c. IsContainer c => c -> Info
containerInfo Host
h
	setContainerProperties :: Chroot -> [ChildProperty] -> Chroot
setContainerProperties (Chroot FilePath
loc b
b InfoPropagator
p Host
h) [ChildProperty]
ps =
		let h' :: Host
h' = Host -> [ChildProperty] -> Host
forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties Host
h [ChildProperty]
ps
		in FilePath -> b -> InfoPropagator -> Host -> Chroot
forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
loc b
b InfoPropagator
p Host
h'

chrootSystem :: Chroot -> Maybe System
chrootSystem :: Chroot -> Maybe System
chrootSystem = InfoVal System -> Maybe System
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal System -> Maybe System)
-> (Chroot -> InfoVal System) -> Chroot -> Maybe System
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> InfoVal System
forall v. IsInfo v => Info -> v
fromInfo (Info -> InfoVal System)
-> (Chroot -> Info) -> Chroot -> InfoVal System
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chroot -> Info
forall c. IsContainer c => c -> Info
containerInfo

instance Show Chroot where
	show :: Chroot -> FilePath
show c :: Chroot
c@(Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) = FilePath
"Chroot " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe System -> FilePath
forall a. Show a => a -> FilePath
show (Chroot -> Maybe System
chrootSystem Chroot
c)

-- | Class of things that can do initial bootstrapping of an operating
-- System in a chroot.
class ChrootBootstrapper b where
	-- | Do initial bootstrapping of an operating system in a chroot.
	-- If the operating System is not supported, return
	-- Left error message.
	buildchroot 
		:: b
		-> Info -- ^ info of the Properties of the chroot
		-> FilePath -- ^ where to bootstrap the chroot
		-> Either String (Property Linux)

-- | Use this to bootstrap a chroot by extracting a tarball.
--
-- The tarball is expected to contain a root directory (no top-level
-- directory, also known as a "tarbomb").
-- It may be optionally compressed with any format `tar` knows how to
-- detect automatically.
data ChrootTarball = ChrootTarball FilePath

instance ChrootBootstrapper ChrootTarball where
	buildchroot :: ChrootTarball
-> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot (ChrootTarball FilePath
tb) Info
_ FilePath
loc = Property Linux -> Either FilePath (Property Linux)
forall a b. b -> Either a b
Right (Property Linux -> Either FilePath (Property Linux))
-> Property Linux -> Either FilePath (Property Linux)
forall a b. (a -> b) -> a -> b
$
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
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 Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
extractTarball FilePath
loc FilePath
tb

extractTarball :: FilePath -> FilePath -> Property UnixLike
extractTarball :: FilePath
-> FilePath
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
extractTarball FilePath
target FilePath
src = IO Bool
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (FilePath -> IO Bool
isUnpopulated FilePath
target) (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
	FilePath
-> [FilePath]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty FilePath
"tar" [FilePath]
params
		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
		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
`requires` FilePath
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.dirExists FilePath
target
  where
	params :: [FilePath]
params =
		[ FilePath
"-C"
		, FilePath
target
		, FilePath
"-xf"
		, FilePath
src
		]

-- | Use this to bootstrap a chroot with debootstrap.
data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig

instance ChrootBootstrapper Debootstrapped where
	buildchroot :: Debootstrapped
-> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot (Debootstrapped DebootstrapConfig
cf) Info
info FilePath
loc = case Maybe System
system of
		(Just s :: System
s@(System (Debian DebianKernel
_ DebianSuite
_) Architecture
_)) -> Property Linux -> Either FilePath (Property Linux)
forall a b. b -> Either a b
Right (Property Linux -> Either FilePath (Property Linux))
-> Property Linux -> Either FilePath (Property Linux)
forall a b. (a -> b) -> a -> b
$ System -> Property Linux
debootstrap System
s
		(Just s :: System
s@(System (Buntish FilePath
_) Architecture
_)) -> Property Linux -> Either FilePath (Property Linux)
forall a b. b -> Either a b
Right (Property Linux -> Either FilePath (Property Linux))
-> Property Linux -> Either FilePath (Property Linux)
forall a b. (a -> b) -> a -> b
$ System -> Property Linux
debootstrap System
s
		(Just (System Distribution
ArchLinux Architecture
_)) -> FilePath -> Either FilePath (Property Linux)
forall a b. a -> Either a b
Left FilePath
"Arch Linux not supported by debootstrap."
		(Just (System (FreeBSD FreeBSDRelease
_) Architecture
_)) -> FilePath -> Either FilePath (Property Linux)
forall a b. a -> Either a b
Left FilePath
"FreeBSD not supported by debootstrap."
		Maybe System
Nothing -> FilePath -> Either FilePath (Property Linux)
forall a b. a -> Either a b
Left FilePath
"Cannot debootstrap; OS not specified"
	  where
		debootstrap :: System -> Property Linux
debootstrap System
s = FilePath -> System -> DebootstrapConfig -> Property Linux
Debootstrap.built FilePath
loc System
s
			(DebootstrapConfig
cf DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
forall a. Semigroup a => a -> a -> a
<> DebootstrapConfig
proxyConf DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
forall a. Semigroup a => a -> a -> a
<> DebootstrapConfig
mirrorConf)
		system :: Maybe System
system = InfoVal System -> Maybe System
forall v. InfoVal v -> Maybe v
fromInfoVal (Info -> InfoVal System
forall v. IsInfo v => Info -> v
fromInfo Info
info)
		-- If the chroot has a configured apt proxy and/or mirror, pass
		-- these on to debootstrap.  Note that Debootstrap.built does
		-- not get passed the Chroot, so the info inspection has to
		-- happen here, not there
		proxyConf :: DebootstrapConfig
proxyConf = case (InfoVal HostAptProxy -> Maybe HostAptProxy
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal HostAptProxy -> Maybe HostAptProxy)
-> (Info -> InfoVal HostAptProxy) -> Info -> Maybe HostAptProxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> InfoVal HostAptProxy
forall v. IsInfo v => Info -> v
fromInfo) Info
info of
			Just (Apt.HostAptProxy FilePath
u) ->
				FilePath -> DebootstrapConfig
Debootstrap.DebootstrapProxy FilePath
u
			Maybe HostAptProxy
Nothing -> DebootstrapConfig
forall a. Monoid a => a
mempty
		mirrorConf :: DebootstrapConfig
mirrorConf = case (InfoVal HostMirror -> Maybe HostMirror
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal HostMirror -> Maybe HostMirror)
-> (Info -> InfoVal HostMirror) -> Info -> Maybe HostMirror
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> InfoVal HostMirror
forall v. IsInfo v => Info -> v
fromInfo) Info
info of
			Just (Apt.HostMirror FilePath
u) ->
				FilePath -> DebootstrapConfig
Debootstrap.DebootstrapMirror FilePath
u
			Maybe HostMirror
Nothing -> DebootstrapConfig
forall a. Monoid a => a
mempty

-- | Defines a Chroot at the given location, built with debootstrap.
--
-- Properties can be added to configure the Chroot. At a minimum,
-- add a property such as `osDebian` to specify the operating system
-- to bootstrap.
--
-- If the 'Debootstrap.DebootstrapConfig' does not include a 
-- 'Debootstrap.DebootstrapMirror',
-- any 'Apt.mirror' property of the chroot will configure debootstrap.
-- Same for 'Debootstrap.DebootstrapProxy' and 'Apt.proxy'.
--
-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
-- >	& osDebian Unstable X86_64
-- >	& Apt.installed ["ghc", "haskell-platform"]
-- >	& ...
debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
debootstrapped :: DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
debootstrapped DebootstrapConfig
conf = Debootstrapped -> FilePath -> Props metatypes -> Chroot
forall b metatypes.
ChrootBootstrapper b =>
b -> FilePath -> Props metatypes -> Chroot
bootstrapped (DebootstrapConfig -> Debootstrapped
Debootstrapped DebootstrapConfig
conf)

-- | Defines a Chroot at the given location, bootstrapped with the
-- specified ChrootBootstrapper.
--
-- Like 'Chroot.debootstrapped', if the 'ChrootBootstrapper' is
-- 'Debootstrapped', this property respects the Chroot's
-- 'Apt.proxy' and 'Apt.mirror' properties.
bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
bootstrapped :: b -> FilePath -> Props metatypes -> Chroot
bootstrapped b
bootstrapper FilePath
location Props metatypes
ps = Chroot
c
  where
	c :: Chroot
c = FilePath -> b -> InfoPropagator -> Host -> Chroot
forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
location b
bootstrapper InfoPropagator
propagateChrootInfo (FilePath -> Props metatypes -> Host
forall metatypes. FilePath -> Props metatypes -> Host
host FilePath
location Props metatypes
ps)

-- | Ensures that the chroot exists and is provisioned according to its
-- properties.
--
-- Reverting this property removes the chroot. Anything mounted inside it
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
provisioned Chroot
c = Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' Chroot
c Bool
False [ContainerCapability
FilesystemContained]

provisioned'
	:: Chroot
	-> Bool
	-> [ContainerCapability]
	-> RevertableProperty (HasInfo + Linux) Linux
provisioned' :: Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' c :: Chroot
c@(Chroot FilePath
loc b
bootstrapper InfoPropagator
infopropigator Host
_) Bool
systemdonly [ContainerCapability]
caps =
	(InfoPropagator
infopropigator Chroot
c PropagateInfo -> Bool
normalContainerInfo (Property Linux -> Property (HasInfo + Linux))
-> Property Linux -> Property (HasInfo + Linux)
forall a b. (a -> b) -> a -> b
$ Property Linux
setup Property Linux -> FilePath -> Property Linux
forall p. IsProp p => p -> FilePath -> p
`describe` Chroot -> ShowS
chrootDesc Chroot
c FilePath
"exists")
		Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
-> Property Linux
-> RevertableProperty
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
	(Property Linux
teardown Property Linux -> FilePath -> Property Linux
forall p. IsProp p => p -> FilePath -> p
`describe` Chroot -> ShowS
chrootDesc Chroot
c FilePath
"removed")
  where
	setup :: Property Linux
	setup :: Property Linux
setup = Chroot
-> ([FilePath] -> IO (CreateProcess, IO ()))
-> Bool
-> [ContainerCapability]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
propellChroot Chroot
c (Bool -> Chroot -> [FilePath] -> IO (CreateProcess, IO ())
inChrootProcess (Bool -> Bool
not Bool
systemdonly) Chroot
c) Bool
systemdonly [ContainerCapability]
caps
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
-> CombinedType
     (Property
        (MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property Linux
built

	built :: Property Linux
built = case b -> Info -> FilePath -> Either FilePath (Property Linux)
forall b.
ChrootBootstrapper b =>
b -> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot b
bootstrapper (Chroot -> Info
forall c. IsContainer c => c -> Info
containerInfo Chroot
c) FilePath
loc of
		Right Property Linux
p -> Property Linux
p
		Left FilePath
e -> FilePath -> Property Linux
cantbuild FilePath
e

	cantbuild :: FilePath -> Property Linux
cantbuild FilePath
e = FilePath -> Propellor Result -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (Chroot -> ShowS
chrootDesc Chroot
c FilePath
"built") (FilePath -> Propellor Result
forall a. HasCallStack => FilePath -> a
error FilePath
e)

	teardown :: Property Linux
	teardown :: Property Linux
teardown = IO Bool -> Property Linux -> Property Linux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
isUnpopulated FilePath
loc) (Property Linux -> Property Linux)
-> Property Linux -> Property Linux
forall a b. (a -> b) -> a -> b
$
		FilePath -> Propellor Result -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
"removed " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
loc) (Propellor Result -> Property Linux)
-> Propellor Result -> Property Linux
forall a b. (a -> b) -> a -> b
$
			IO () -> Propellor Result
makeChange (FilePath -> IO ()
removeChroot FilePath
loc)

type InfoPropagator = Chroot -> (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)

propagateChrootInfo :: InfoPropagator
propagateChrootInfo :: InfoPropagator
propagateChrootInfo c :: Chroot
c@(Chroot FilePath
location b
_ InfoPropagator
_ Host
_) PropagateInfo -> Bool
pinfo Property Linux
p =
	FilePath
-> Chroot
-> (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) =>
FilePath
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer FilePath
location Chroot
c PropagateInfo -> Bool
pinfo (Property
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux])
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux]))
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
		Property Linux
p Property Linux
-> Info
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` Chroot -> Info
chrootInfo Chroot
c

chrootInfo :: Chroot -> Info
chrootInfo :: Chroot -> Info
chrootInfo (Chroot FilePath
loc b
_ InfoPropagator
_ Host
h) = Info
forall a. Monoid a => a
mempty Info -> ChrootInfo -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo`
	ChrootInfo
forall a. Monoid a => a
mempty { _chroots :: Map FilePath Host
_chroots = FilePath -> Host -> Map FilePath Host
forall k a. k -> a -> Map k a
M.singleton FilePath
loc Host
h }

-- | Propellor is run inside the chroot to provision it.
propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> [ContainerCapability] -> Property UnixLike
propellChroot :: Chroot
-> ([FilePath] -> IO (CreateProcess, IO ()))
-> Bool
-> [ContainerCapability]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
propellChroot c :: Chroot
c@(Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) [FilePath] -> IO (CreateProcess, IO ())
mkproc Bool
systemdonly [ContainerCapability]
caps = FilePath
-> Propellor Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (Chroot -> ShowS
chrootDesc Chroot
c FilePath
"provisioned") (Propellor Result
 -> Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ do
	let d :: FilePath
d = FilePath
localdir FilePath -> ShowS
</> Chroot -> FilePath
shimdir Chroot
c
	let me :: FilePath
me = FilePath
localdir FilePath -> ShowS
</> FilePath
"propellor"
	FilePath
shim <- IO FilePath -> Propellor FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Propellor FilePath)
-> IO FilePath -> Propellor FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath -> IO FilePath
Shim.setup FilePath
me Maybe FilePath
forall a. Maybe a
Nothing FilePath
d
	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
$ FilePath -> IO Bool
bindmount FilePath
shim)
		( FilePath -> Propellor Result
chainprovision FilePath
shim
		, Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
		)
  where
	bindmount :: FilePath -> IO Bool
bindmount FilePath
shim = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
doesFileExist (FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
shim))
		( Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
		, do
			let mntpnt :: FilePath
mntpnt = FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
localdir
			Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
mntpnt
			FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"mount"
				[ FilePath -> CommandParam
Param FilePath
"--bind"
				, FilePath -> CommandParam
File FilePath
localdir, FilePath -> CommandParam
File FilePath
mntpnt
				]
		)

	chainprovision :: FilePath -> Propellor Result
chainprovision FilePath
shim = do
		FilePath
parenthost <- (Host -> FilePath) -> Propellor FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> FilePath
hostName
		CmdLine
cmd <- IO CmdLine -> Propellor CmdLine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CmdLine -> Propellor CmdLine)
-> IO CmdLine -> Propellor CmdLine
forall a b. (a -> b) -> a -> b
$ FilePath -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain FilePath
parenthost Chroot
c Bool
systemdonly [ContainerCapability]
caps
		[(FilePath, FilePath)]
pe <- IO [(FilePath, FilePath)] -> Propellor [(FilePath, FilePath)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FilePath, FilePath)]
standardPathEnv
		(CreateProcess
p, IO ()
cleanup) <- IO (CreateProcess, IO ()) -> Propellor (CreateProcess, IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CreateProcess, IO ()) -> Propellor (CreateProcess, IO ()))
-> IO (CreateProcess, IO ()) -> Propellor (CreateProcess, IO ())
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (CreateProcess, IO ())
mkproc
			[ FilePath
shim
			, FilePath
"--continue"
			, CmdLine -> FilePath
forall a. Show a => a -> FilePath
show CmdLine
cmd
			]
		Result
r <- 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
$ CreateProcess -> IO Result
chainPropellor (CreateProcess
p { env :: Maybe [(FilePath, FilePath)]
env = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
pe })
		IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
cleanup
		Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
r

toChain :: HostName -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain :: FilePath -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain FilePath
parenthost (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) Bool
systemdonly [ContainerCapability]
caps = do
	Bool
onconsole <- MessageHandle -> Bool
isConsole (MessageHandle -> Bool) -> IO MessageHandle -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO MessageHandle
getMessageHandle
	CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Bool -> Bool -> [ContainerCapability] -> CmdLine
ChrootChain FilePath
parenthost FilePath
loc Bool
systemdonly Bool
onconsole [ContainerCapability]
caps

chain :: [Host] -> CmdLine -> IO ()
chain :: [Host] -> CmdLine -> IO ()
chain [Host]
hostlist (ChrootChain FilePath
hn FilePath
loc Bool
systemdonly Bool
onconsole [ContainerCapability]
caps) =
	case [Host] -> FilePath -> Maybe Host
findHostNoAlias [Host]
hostlist FilePath
hn of
		Maybe Host
Nothing -> FilePath -> IO ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage (FilePath
"cannot find host " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
hn)
		Just Host
parenthost -> case FilePath -> Map FilePath Host -> Maybe Host
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
loc (ChrootInfo -> Map FilePath Host
_chroots (ChrootInfo -> Map FilePath Host)
-> ChrootInfo -> Map FilePath Host
forall a b. (a -> b) -> a -> b
$ Info -> ChrootInfo
forall v. IsInfo v => Info -> v
fromInfo (Info -> ChrootInfo) -> Info -> ChrootInfo
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
parenthost) of
			Maybe Host
Nothing -> FilePath -> IO ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage (FilePath
"cannot find chroot " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" on host " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
hn)
			Just Host
h -> Host -> IO ()
go Host
h
  where
	go :: Host -> IO ()
go Host
h = do
		FilePath -> IO ()
changeWorkingDirectory FilePath
localdir
		Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
onconsole IO ()
forceConsole
		FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
onlyProcess (ShowS
provisioningLock FilePath
loc) (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
$
					if Bool
systemdonly
						then [Property DebianLike -> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty Property DebianLike
Systemd.installed]
						else Host -> [ChildProperty]
hostProperties Host
h
	setcaps :: Host -> Host
setcaps Host
h = Host
h { hostInfo :: Info
hostInfo = Host -> Info
hostInfo Host
h Info -> [ContainerCapability] -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` [ContainerCapability]
caps }
chain [Host]
_ CmdLine
_ = FilePath -> IO ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage FilePath
"bad chain command"

inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
inChrootProcess :: Bool -> Chroot -> [FilePath] -> IO (CreateProcess, IO ())
inChrootProcess Bool
keepprocmounted (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) [FilePath]
cmd = do
	IO ()
mountproc
	(CreateProcess, IO ()) -> IO (CreateProcess, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"chroot" (FilePath
locFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
cmd), IO ()
cleanup)
  where
	-- /proc needs to be mounted in the chroot for the linker to use
	-- /proc/self/exe which is necessary for some commands to work
	mountproc :: IO ()
mountproc = IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
procloc ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
mountPointsBelow FilePath
loc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> MountOpts -> IO Bool
mount FilePath
"proc" FilePath
"proc" FilePath
procloc MountOpts
forall a. Monoid a => a
mempty

	procloc :: FilePath
procloc = FilePath
loc FilePath -> ShowS
</> FilePath
"proc"

	cleanup :: IO ()
cleanup
		| Bool
keepprocmounted = IO ()
forall (m :: * -> *). Monad m => m ()
noop
		| Bool
otherwise = IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
procloc ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
mountPointsBelow FilePath
loc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
			FilePath -> IO ()
umountLazy FilePath
procloc

provisioningLock :: FilePath -> FilePath
provisioningLock :: ShowS
provisioningLock FilePath
containerloc = FilePath
"chroot" FilePath -> ShowS
</> ShowS
mungeloc FilePath
containerloc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".lock"

shimdir :: Chroot -> FilePath
shimdir :: Chroot -> FilePath
shimdir (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) = FilePath
"chroot" FilePath -> ShowS
</> ShowS
mungeloc FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".shim"

mungeloc :: FilePath -> String
mungeloc :: ShowS
mungeloc = FilePath -> FilePath -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace FilePath
"/" FilePath
"_"

chrootDesc :: Chroot -> String -> String
chrootDesc :: Chroot -> ShowS
chrootDesc (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) FilePath
desc = FilePath
"chroot " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc

-- | Runs an action with the true localdir exposed,
-- not the one bind-mounted into a chroot. The action is passed the
-- path containing the contents of the localdir outside the chroot.
--
-- In a chroot, this is accomplished by temporily bind mounting the localdir
-- to a temp directory, to preserve access to the original bind mount. Then
-- we unmount the localdir to expose the true localdir. Finally, to cleanup,
-- the temp directory is bind mounted back to the localdir.
exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
exposeTrueLocaldir FilePath -> Propellor a
a = Propellor Bool -> (Propellor a, Propellor a) -> Propellor a
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
FilesystemContained)
	( FilePath -> FilePath -> (FilePath -> Propellor a) -> Propellor a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTmpDirIn (ShowS
takeDirectory FilePath
localdir) FilePath
"propellor.tmp" ((FilePath -> Propellor a) -> Propellor a)
-> (FilePath -> Propellor a) -> Propellor a
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpdir ->
		Propellor () -> Propellor () -> Propellor a -> Propellor a
forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_
			(FilePath -> FilePath -> Propellor ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
movebindmount FilePath
localdir FilePath
tmpdir)
			(FilePath -> FilePath -> Propellor ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
movebindmount FilePath
tmpdir FilePath
localdir)
			(FilePath -> Propellor a
a FilePath
tmpdir)
	, FilePath -> Propellor a
a FilePath
localdir
	)
  where
	movebindmount :: FilePath -> FilePath -> m ()
movebindmount FilePath
from FilePath
to = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
		FilePath -> [CommandParam] -> IO ()
run FilePath
"mount" [FilePath -> CommandParam
Param FilePath
"--bind", FilePath -> CommandParam
File FilePath
from, FilePath -> CommandParam
File FilePath
to]
		-- Have to lazy unmount, because the propellor process
		-- is running in the localdir that it's unmounting..
		FilePath -> [CommandParam] -> IO ()
run FilePath
"umount" [FilePath -> CommandParam
Param FilePath
"-l", FilePath -> CommandParam
File FilePath
from]
		-- We were in the old localdir; move to the new one after
		-- flipping the bind mounts. Otherwise, commands that try
		-- to access the cwd will fail because it got umounted out
		-- from under.
		FilePath -> IO ()
changeWorkingDirectory FilePath
"/"
		FilePath -> IO ()
changeWorkingDirectory FilePath
localdir
	run :: FilePath -> [CommandParam] -> IO ()
run FilePath
cmd [CommandParam]
ps = IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
cmd [CommandParam]
ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"exposeTrueLocaldir failed to run " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (FilePath, [CommandParam]) -> FilePath
forall a. Show a => a -> FilePath
show (FilePath
cmd, [CommandParam]
ps)

-- | Generates a Chroot that has all the properties of a Host.
-- 
-- Note that it's possible to create loops using this, where a host
-- contains a Chroot containing itself etc. Such loops will be detected at
-- runtime.
hostChroot :: ChrootBootstrapper bootstrapper => Host -> bootstrapper -> FilePath -> Chroot
hostChroot :: Host -> bootstrapper -> FilePath -> Chroot
hostChroot Host
h bootstrapper
bootstrapper FilePath
d = Chroot
chroot
  where
	chroot :: Chroot
chroot = FilePath -> bootstrapper -> InfoPropagator -> Host -> Chroot
forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
d bootstrapper
bootstrapper InfoPropagator
pinfo Host
h
	pinfo :: InfoPropagator
pinfo = Host -> InfoPropagator
propagateHostChrootInfo Host
h

-- This is different than propagateChrootInfo in that Info using
-- HostContext is not made to use the name of the chroot as its context,
-- but instead uses the hostname of the Host.
propagateHostChrootInfo :: Host -> InfoPropagator
propagateHostChrootInfo :: Host -> InfoPropagator
propagateHostChrootInfo Host
h Chroot
c PropagateInfo -> Bool
pinfo Property Linux
p =
	FilePath
-> Chroot
-> (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) =>
FilePath
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer (Host -> FilePath
hostName Host
h) Chroot
c PropagateInfo -> Bool
pinfo (Property
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux])
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux]))
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
		Property Linux
p Property Linux
-> Info
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` Chroot -> Info
chrootInfo Chroot
c

-- | Ensure that a chroot uses the host's Apt proxy.
--
-- This property is often used for 'Sbuild.built' chroots, when the host has
-- 'Apt.useLocalCacher'.
useHostProxy :: Host -> Property DebianLike
useHostProxy :: Host -> Property DebianLike
useHostProxy Host
h = FilePath
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
"use host's apt proxy" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w ->
	-- Note that we can't look at getProxyInfo outside the property,
	-- as that would loop, but it's ok to look at it inside the
	-- property. Thus the slightly strange construction here.
	case Host -> Maybe HostAptProxy
getProxyInfo Host
h of
		Just (Apt.HostAptProxy FilePath
u) -> OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (FilePath -> Property DebianLike
Apt.proxy' FilePath
u)
		Maybe HostAptProxy
Nothing -> Propellor Result
noChange
  where
	getProxyInfo :: Host -> Maybe HostAptProxy
getProxyInfo = InfoVal HostAptProxy -> Maybe HostAptProxy
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal HostAptProxy -> Maybe HostAptProxy)
-> (Host -> InfoVal HostAptProxy) -> Host -> Maybe HostAptProxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> InfoVal HostAptProxy
forall v. IsInfo v => Info -> v
fromInfo (Info -> InfoVal HostAptProxy)
-> (Host -> Info) -> Host -> InfoVal HostAptProxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo