{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE TypeFamilies #-}
module Propellor.Property.Sbuild (
UseCcache(..),
built,
update,
osDebianStandard,
keypairGenerated,
keypairInsecurelyGenerated,
usableBy,
userConfig,
) where
import Propellor.Base
import Propellor.Types.Core
import Propellor.Types.Info
import Propellor.Property.Debootstrap (extractSuite)
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Ccache as Ccache
import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Schroot as Schroot
import qualified Propellor.Property.Reboot as Reboot
import qualified Propellor.Property.Localdir as Localdir
import qualified Propellor.Property.User as User
import Data.List
data UseCcache = UseCcache | NoCcache
built
:: UseCcache
-> Props metatypes
-> RevertableProperty (HasInfo + DebianLike) Linux
built :: forall metatypes.
UseCcache
-> Props metatypes
-> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
built UseCcache
cc Props metatypes
ps = case Props metatypes -> Maybe System
forall metatypes. Props metatypes -> Maybe System
schrootSystem Props metatypes
ps of
Maybe System
Nothing -> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
emitError
Just s :: System
s@(System Distribution
_ Architecture
arch) -> case System -> Maybe String
extractSuite System
s of
Maybe String
Nothing -> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
emitError
Just String
suite -> UseCcache
-> Props metatypes
-> String
-> String
-> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
forall metatypes.
UseCcache
-> Props metatypes
-> String
-> String
-> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
built' UseCcache
cc Props metatypes
ps String
suite
(Architecture -> String
architectureToDebianArchString Architecture
arch)
where
schrootSystem :: Props metatypes -> Maybe System
schrootSystem :: forall metatypes. Props metatypes -> Maybe System
schrootSystem (Props [ChildProperty]
ps') = InfoVal System -> Maybe System
forall v. InfoVal v -> Maybe v
fromInfoVal (InfoVal System -> Maybe System)
-> (Info -> InfoVal System) -> Info -> Maybe System
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> InfoVal System
forall v. IsInfo v => Info -> v
fromInfo (Info -> Maybe System) -> Info -> Maybe System
forall a b. (a -> b) -> a -> b
$
[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
getInfo [ChildProperty]
ps')
emitError :: RevertableProperty (HasInfo + DebianLike) Linux
emitError :: RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
emitError = String
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (t :: k). SingI t => String -> Property (MetaTypes t)
impossible String
theError Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property Linux
-> RevertableProperty
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> String -> Property Linux
forall {k} (t :: k). SingI t => String -> Property (MetaTypes t)
impossible String
theError
theError :: String
theError = String
"sbuild schroot does not specify suite and/or architecture"
built'
:: UseCcache
-> Props metatypes
-> String
-> String
-> RevertableProperty (HasInfo + DebianLike) Linux
built' :: forall metatypes.
UseCcache
-> Props metatypes
-> String
-> String
-> RevertableProperty
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
built' UseCcache
cc (Props [ChildProperty]
ps) String
suite String
arch = Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Property
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
provisioned Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property Linux
-> RevertableProperty
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
deleted
where
provisioned :: Property (HasInfo + DebianLike)
provisioned :: Property
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
provisioned = String
-> Props
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc (Props
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Props
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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 UnixLike
cleanupOldConfig
Props UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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])
overlaysKernel
Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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])
preReqsInstalled
Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& UseCcache
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
ccacheMaybePrepared UseCcache
cc
Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> RevertableProperty
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Linux
-> Props
(Sing
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ '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))
& Chroot -> RevertableProperty (HasInfo + Linux) Linux
Chroot.provisioned Chroot
schroot
Props
(Sing
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& String
-> String
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
conf String
suite String
arch
where
desc :: String
desc = String
"built sbuild schroot for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suiteArch
deleted :: Property Linux
deleted :: Property Linux
deleted = String -> Props Linux -> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc (Props Linux -> Property Linux) -> Props Linux -> Property Linux
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> RevertableProperty
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
Linux
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall {a} {k} (x :: [a]) (z :: [a]) (y :: k).
CheckCombinableNote x z (NoteFor ('Text "!")) =>
Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))
! Chroot -> RevertableProperty (HasInfo + Linux) Linux
Chroot.provisioned Chroot
schroot
Props Linux
-> RevertableProperty UnixLike UnixLike
-> Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall {a} {k} (x :: [a]) (z :: [a]) (y :: k).
CheckCombinableNote x z (NoteFor ('Text "!")) =>
Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))
! RevertableProperty UnixLike UnixLike
compatSymlink
Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(MetaTypes
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> Property UnixLike
File.notPresent String
schrootConf
where
desc :: String
desc = String
"no sbuild schroot for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suiteArch
conf :: String
-> String
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
conf String
suite' String
arch' = String
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"sbuild config file" (Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])))
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"description" (String
suite' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" autobuilder")
Props UnixLike
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"groups" String
"root,sbuild"
Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"root-groups" String
"root,sbuild"
Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"profile" String
"sbuild"
Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"type" String
"directory"
Props
(Sing
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"directory" String
schrootRoot
Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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])
unionTypeOverlay
Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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 UnixLike
aliasesLine
Props
(Sing
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> String -> Property UnixLike
pair String
"command-prefix" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
commandPrefix)
where
pair :: String -> String -> Property UnixLike
pair String
k String
v = String -> (String, String, String) -> Property UnixLike
ConfFile.containsIniSetting String
schrootConf
(String
suiteArch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sbuild", String
k, String
v)
unionTypeOverlay :: Property DebianLike
unionTypeOverlay :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
unionTypeOverlay = String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
"add union-type = overlay" ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w ->
Propellor Bool
Schroot.usesOverlays Propellor Bool -> (Bool -> Propellor Result) -> Propellor Result
forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
usesOverlays ->
if Bool
usesOverlays
then OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
String -> String -> Property UnixLike
pair String
"union-type" String
"overlay"
else Propellor Result
noChange
compatSymlink :: RevertableProperty UnixLike UnixLike
compatSymlink = String -> LinkTarget -> RevertableProperty UnixLike UnixLike
File.isSymlinkedTo
(String
"/etc/sbuild/chroot" String -> String -> String
</> String
suiteArch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sbuild")
(String -> LinkTarget
File.LinkTarget String
schrootRoot)
aliasesLine :: Property UnixLike
aliasesLine :: Property UnixLike
aliasesLine = String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
"maybe set aliases line" ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike)
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w ->
String -> String -> Propellor Bool
sidHostArchSchroot String
suite String
arch Propellor Bool -> (Bool -> Propellor Result) -> Propellor Result
forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isSidHostArchSchroot ->
if Bool
isSidHostArchSchroot
then OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> 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, 'Targeting 'OSFreeBSD]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
String -> (String, String, String) -> Property UnixLike
ConfFile.containsIniSetting String
schrootConf
( String
suiteArch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sbuild"
, String
"aliases"
, String
aliases
)
else Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
overlaysKernel :: Property DebianLike
overlaysKernel :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
overlaysKernel = String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
"reboot for union-type=overlay" ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w ->
Propellor Bool
Schroot.usesOverlays Propellor Bool -> (Bool -> Propellor Result) -> Propellor Result
forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
usesOverlays ->
if Bool
usesOverlays
then OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
String
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Reboot.toKernelNewerThan String
"3.18"
else Propellor Result
noChange
cleanupOldConfig :: Property UnixLike
cleanupOldConfig :: Property UnixLike
cleanupOldConfig =
String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
"old sbuild module config cleaned up" ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike)
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
Propellor Result -> Propellor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propellor Result -> Propellor ())
-> Propellor Result -> Propellor ()
forall a b. (a -> b) -> a -> b
$ OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> 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, 'Targeting 'OSFreeBSD]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (String -> IO Bool
doesFileExist String
fstab)
(String -> String -> Property UnixLike
File.lacksLine String
fstab String
aptCacheLine)
Propellor (Either IOException ()) -> Propellor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propellor (Either IOException ()) -> Propellor ())
-> Propellor (Either IOException ()) -> Propellor ()
forall a b. (a -> b) -> a -> b
$ IO (Either IOException ()) -> Propellor (Either IOException ())
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ()) -> Propellor (Either IOException ()))
-> (IO () -> IO (Either IOException ()))
-> IO ()
-> Propellor (Either IOException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> Propellor (Either IOException ()))
-> IO () -> Propellor (Either IOException ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
profile
Propellor () -> Propellor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propellor () -> Propellor ()) -> Propellor () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ IO () -> Propellor ()
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
nukeFile String
schrootPiupartsConf
Propellor Result
noChange
where
fstab :: String
fstab = String
"/etc/schroot/sbuild/fstab"
profile :: String
profile = String
"/etc/schroot/piuparts"
schrootPiupartsConf :: String
schrootPiupartsConf = String
"/etc/schroot/chroot.d"
String -> String -> String
</> String
suiteArch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-piuparts-propellor"
schroot :: Chroot
schroot = DebootstrapConfig -> String -> Props Any -> Chroot
forall metatypes.
DebootstrapConfig -> String -> Props metatypes -> Chroot
Chroot.debootstrapped DebootstrapConfig
Debootstrap.BuilddD
String
schrootRoot ([ChildProperty] -> Props Any
forall metatypes. [ChildProperty] -> Props metatypes
Props [ChildProperty]
schrootProps)
schrootProps :: [ChildProperty]
schrootProps =
[ChildProperty]
ps [ChildProperty] -> [ChildProperty] -> [ChildProperty]
forall a. [a] -> [a] -> [a]
++ [Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty (Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> ChildProperty)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> ChildProperty
forall a b. (a -> b) -> a -> b
$ [String]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.installed [String
"eatmydata", String
"ccache"]
, Property UnixLike -> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty (Property UnixLike -> ChildProperty)
-> Property UnixLike -> ChildProperty
forall a b. (a -> b) -> a -> b
$ Property UnixLike
Localdir.removed]
suiteArch :: String
suiteArch = String
suite String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch
schrootRoot :: String
schrootRoot = String
"/srv/chroot" String -> String -> String
</> String
suiteArch
schrootConf :: String
schrootConf = String
"/etc/schroot/chroot.d"
String -> String -> String
</> String
suiteArch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sbuild-propellor"
aliases :: String
aliases = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
","
[ String
"sid"
, String
"rc-buggy"
, String
"experimental"
, String
"UNRELEASED"
, String
"UNRELEASED-"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sbuild"
]
commandPrefix :: [String]
commandPrefix = case UseCcache
cc of
UseCcache
UseCcache -> String
"/var/cache/ccache-sbuild/sbuild-setup"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
base
UseCcache
_ -> [String]
base
where
base :: [String]
base = [String
"eatmydata"]
osDebianStandard :: Property Debian
osDebianStandard :: Property Debian
osDebianStandard = String -> Props Debian -> Property Debian
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList String
"standard Debian sbuild properties" (Props Debian -> Property Debian)
-> Props Debian -> Property Debian
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property Debian
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian]))
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 Debian
Apt.stdSourcesList
update :: Property DebianLike
update :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
update = Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.update Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.upgrade Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.autoRemove
aptCacheLine :: String
aptCacheLine :: String
aptCacheLine = String
"/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
preReqsInstalled :: Property DebianLike
preReqsInstalled :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
preReqsInstalled = [String]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.installed [String
"piuparts", String
"autopkgtest", String
"lintian", String
"sbuild"]
usableBy :: User -> Property DebianLike
usableBy :: User
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
usableBy User
u = User
-> Group
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
User.hasGroup User
u (String -> Group
Group String
"sbuild") Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
preReqsInstalled
keypairGenerated :: Property DebianLike
keypairGenerated :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
keypairGenerated = IO Bool
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
<$> String -> IO Bool
doesFileExist String
secKeyFile) (Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
preReqsInstalled
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property UnixLike
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property UnixLike
File.dirExists String
"/root/.gnupg"
where
go :: Property DebianLike
go :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go = Property UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall (untightened :: [MetaType]) (tightened :: [MetaType]).
(TightenTargetsAllowed untightened tightened, SingI tightened) =>
Property (MetaTypes untightened) -> Property (MetaTypes tightened)
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$
String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"sbuild-update" [String
"--keygen"]
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
secKeyFile :: FilePath
secKeyFile :: String
secKeyFile = String
"/var/lib/sbuild/apt-keys/sbuild-key.sec"
keypairInsecurelyGenerated :: Property DebianLike
keypairInsecurelyGenerated :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
keypairInsecurelyGenerated = IO Bool
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
<$> String -> IO Bool
doesFileExist String
secKeyFile) Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go
where
go :: Property DebianLike
go :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go = String
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"sbuild keyring insecurely generated" (Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& [String]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.installed [String
"rng-tools"]
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property UnixLike
-> Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> Property UnixLike
File.dirExists String
"/var/lib/sbuild/apt-keys"
Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& User -> [String] -> UncheckedProperty UnixLike
userScriptProperty (String -> User
User String
"root")
[ String
"start-stop-daemon -q -K -R 10 -o -n rngd"
, String
"rngd -r /dev/urandom"
]
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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])
keypairGenerated
Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property UnixLike
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& User -> [String] -> UncheckedProperty UnixLike
userScriptProperty (String -> User
User String
"root")
[String
"kill $(cat /var/run/rngd.pid)"]
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
ccacheMaybePrepared :: UseCcache -> Property DebianLike
ccacheMaybePrepared :: UseCcache
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
ccacheMaybePrepared UseCcache
cc = case UseCcache
cc of
UseCcache
UseCcache -> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
ccachePrepared
UseCcache
NoCcache -> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
ccachePrepared :: Property DebianLike
ccachePrepared :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
ccachePrepared = String
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList String
"sbuild group ccache configured" (Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& IO Bool
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
<$> String -> IO Bool
doesDirectoryExist String
"/var/cache/ccache-sbuild")
(String
-> Limit
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Ccache.hasLimits String
"/var/cache/ccache-sbuild" (String -> Limit
Ccache.MaxSize String
"2G"))
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
UnixLike
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Group
-> Limit
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
UnixLike
Ccache.hasCache (String -> Group
Group String
"sbuild") Limit
Ccache.NoLimit
Props
(Sing
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String
"/etc/schroot/sbuild/fstab" String -> String -> Property UnixLike
`File.containsLine`
String
"/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0"
Property UnixLike -> String -> Property UnixLike
forall p. IsProp p => p -> String -> p
`describe` String
"ccache mounted in sbuild schroots"
Props
(Sing
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String
"/var/cache/ccache-sbuild/sbuild-setup" String -> [String] -> Property UnixLike
`File.hasContent`
[ String
"#!/bin/sh"
, String
""
, String
"export CCACHE_DIR=/var/cache/ccache-sbuild"
, String
"export CCACHE_UMASK=002"
, String
"export CCACHE_COMPRESS=1"
, String
"unset CCACHE_HARDLINK"
, String
"export PATH=\"/usr/lib/ccache:$PATH\""
, String
""
, String
"exec \"$@\""
]
Props
(Sing
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property UnixLike
-> Props
(MetaTypes
(Combine
(Combine
(Combine
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& String -> FileMode -> Property UnixLike
File.mode String
"/var/cache/ccache-sbuild/sbuild-setup"
([FileMode] -> FileMode
combineModes ([FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
userConfig :: User -> Property DebianLike
userConfig :: User
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
userConfig user :: User
user@(User String
u) = Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` User
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
usableBy User
user
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
preReqsInstalled
where
go :: Property DebianLike
go :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go = String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (String
"~/.sbuildrc for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u) ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
String
h <- IO String -> Propellor String
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> IO String
User.homedir User
user)
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property UnixLike
File.hasContent (String
h String -> String -> String
</> String
".sbuildrc")
[ String
"$run_lintian = 1;"
, String
""
, String
"$run_piuparts = 1;"
, String
"$piuparts_opts = ["
, String
" '--no-eatmydata',"
, String
" '--schroot',"
, String
" '%r-%a-sbuild',"
, String
" '--fail-if-inadequate',"
, String
" ];"
, String
""
, String
"$run_autopkgtest = 1;"
, String
"$autopkgtest_root_args = \"\";"
, String
"$autopkgtest_opts = [\"--\", \"schroot\", \"%r-%a-sbuild\"];"
]
sidHostArchSchroot :: String -> String -> Propellor Bool
sidHostArchSchroot :: String -> String -> Propellor Bool
sidHostArchSchroot String
suite String
arch = do
Maybe System
maybeOS <- Propellor (Maybe System)
getOS
Bool -> Propellor Bool
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Propellor Bool) -> Bool -> Propellor Bool
forall a b. (a -> b) -> a -> b
$ case Maybe System
maybeOS of
Maybe System
Nothing -> Bool
False
Just (System Distribution
_ Architecture
hostArch) ->
let hostArch' :: String
hostArch' = Architecture -> String
architectureToDebianArchString Architecture
hostArch
in String
suite String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"unstable" Bool -> Bool -> Bool
&& String
hostArch' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
arch