{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Propellor.Property.Apt where
import Data.Maybe
import Data.List
import Data.Typeable
import System.IO
import Control.Monad
import Control.Applicative
import Prelude
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
import Propellor.Property.File (Line)
import Propellor.Types.Info
import Utility.SafeCommand
data HostMirror = HostMirror Url
deriving (HostMirror -> HostMirror -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostMirror -> HostMirror -> Bool
$c/= :: HostMirror -> HostMirror -> Bool
== :: HostMirror -> HostMirror -> Bool
$c== :: HostMirror -> HostMirror -> Bool
Eq, Int -> HostMirror -> ShowS
[HostMirror] -> ShowS
HostMirror -> Url
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [HostMirror] -> ShowS
$cshowList :: [HostMirror] -> ShowS
show :: HostMirror -> Url
$cshow :: HostMirror -> Url
showsPrec :: Int -> HostMirror -> ShowS
$cshowsPrec :: Int -> HostMirror -> ShowS
Show, Typeable)
data HostAptProxy = HostAptProxy Url
deriving (HostAptProxy -> HostAptProxy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAptProxy -> HostAptProxy -> Bool
$c/= :: HostAptProxy -> HostAptProxy -> Bool
== :: HostAptProxy -> HostAptProxy -> Bool
$c== :: HostAptProxy -> HostAptProxy -> Bool
Eq, Int -> HostAptProxy -> ShowS
[HostAptProxy] -> ShowS
HostAptProxy -> Url
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [HostAptProxy] -> ShowS
$cshowList :: [HostAptProxy] -> ShowS
show :: HostAptProxy -> Url
$cshow :: HostAptProxy -> Url
showsPrec :: Int -> HostAptProxy -> ShowS
$cshowsPrec :: Int -> HostAptProxy -> ShowS
Show, Typeable)
mirror :: Url -> Property (HasInfo + UnixLike)
mirror :: Url
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
mirror Url
u = forall v.
IsInfo v =>
Url
-> v
-> Property
(HasInfo
+ MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty (Url
u forall a. [a] -> [a] -> [a]
++ Url
" apt mirror selected")
(forall v. v -> InfoVal v
InfoVal (Url -> HostMirror
HostMirror Url
u))
getMirror :: Propellor Url
getMirror :: Propellor Url
getMirror = do
Maybe HostMirror
mirrorInfo <- Propellor (Maybe HostMirror)
getMirrorInfo
Maybe System
osInfo <- Propellor (Maybe System)
getOS
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Maybe System
osInfo, Maybe HostMirror
mirrorInfo) of
(Maybe System
_, Just (HostMirror Url
u)) -> Url
u
(Just (System (Debian DebianKernel
_ DebianSuite
_) Architecture
_), Maybe HostMirror
_) ->
Url
"http://deb.debian.org/debian"
(Just (System (Buntish Url
_) Architecture
_), Maybe HostMirror
_) ->
Url
"mirror://mirrors.ubuntu.com/"
(Just (System Distribution
dist Architecture
_), Maybe HostMirror
_) ->
forall a. HasCallStack => Url -> a
error (Url
"no Apt mirror defined for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Url
show Distribution
dist)
(Maybe System, Maybe HostMirror)
_ -> forall a. HasCallStack => Url -> a
error Url
"no Apt mirror defined for this host or OS"
where
getMirrorInfo :: Propellor (Maybe HostMirror)
getMirrorInfo :: Propellor (Maybe HostMirror)
getMirrorInfo = forall v. InfoVal v -> Maybe v
fromInfoVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. IsInfo v => Propellor v
askInfo
withMirror :: Desc -> (Url -> Property DebianLike) -> Property DebianLike
withMirror :: Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror Url
desc Url -> Property DebianLike
mkp = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Url
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
Url
u <- Propellor Url
getMirror
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Url -> Property DebianLike
mkp Url
u)
sourcesList :: FilePath
sourcesList :: Url
sourcesList = Url
"/etc/apt/sources.list"
type Url = String
type Section = String
type SourcesGenerator = DebianSuite -> [Line]
showSuite :: DebianSuite -> String
showSuite :: DebianSuite -> Url
showSuite (Stable Url
s) = Url
s
showSuite DebianSuite
Testing = Url
"testing"
showSuite DebianSuite
Unstable = Url
"unstable"
showSuite DebianSuite
Experimental = Url
"experimental"
backportSuite :: DebianSuite -> Maybe String
backportSuite :: DebianSuite -> Maybe Url
backportSuite (Stable Url
s) = forall a. a -> Maybe a
Just (Url
s forall a. [a] -> [a] -> [a]
++ Url
"-backports")
backportSuite DebianSuite
_ = forall a. Maybe a
Nothing
stableUpdatesSuite :: DebianSuite -> Maybe String
stableUpdatesSuite :: DebianSuite -> Maybe Url
stableUpdatesSuite (Stable Url
s) = forall a. a -> Maybe a
Just (Url
s forall a. [a] -> [a] -> [a]
++ Url
"-updates")
stableUpdatesSuite DebianSuite
_ = forall a. Maybe a
Nothing
debLine :: String -> Url -> [Section] -> Line
debLine :: Url -> Url -> [Url] -> Url
debLine Url
suite Url
url [Url]
sections = [Url] -> Url
unwords forall a b. (a -> b) -> a -> b
$
[Url
"deb", Url
url, Url
suite] forall a. [a] -> [a] -> [a]
++ [Url]
sections
srcLine :: Line -> Line
srcLine :: ShowS
srcLine Url
l = case Url -> [Url]
words Url
l of
(Url
"deb":[Url]
rest) -> [Url] -> Url
unwords forall a b. (a -> b) -> a -> b
$ Url
"deb-src" forall a. a -> [a] -> [a]
: [Url]
rest
[Url]
_ -> Url
""
stdSections :: [Section]
stdSections :: [Url]
stdSections = [Url
"main", Url
"contrib", Url
"non-free"]
binandsrc :: String -> SourcesGenerator
binandsrc :: Url -> SourcesGenerator
binandsrc Url
url DebianSuite
suite = forall a. [Maybe a] -> [a]
catMaybes
[ forall a. a -> Maybe a
Just Url
l
, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
srcLine Url
l
, Maybe Url
sul
, ShowS
srcLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Url
sul
, Maybe Url
bl
, ShowS
srcLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Url
bl
]
where
l :: Url
l = Url -> Url -> [Url] -> Url
debLine (DebianSuite -> Url
showSuite DebianSuite
suite) Url
url [Url]
stdSections
bl :: Maybe Url
bl = do
Url
bs <- DebianSuite -> Maybe Url
backportSuite DebianSuite
suite
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Url -> Url -> [Url] -> Url
debLine Url
bs Url
url [Url]
stdSections
sul :: Maybe Url
sul = do
Url
sus <- DebianSuite -> Maybe Url
stableUpdatesSuite DebianSuite
suite
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Url -> Url -> [Url] -> Url
debLine Url
sus Url
url [Url]
stdSections
stdArchiveLines :: Propellor SourcesGenerator
stdArchiveLines :: Propellor SourcesGenerator
stdArchiveLines = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> SourcesGenerator
binandsrc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor Url
getMirror
securityUpdates :: SourcesGenerator
securityUpdates :: SourcesGenerator
securityUpdates DebianSuite
suite
| DebianSuite -> Bool
isStable DebianSuite
suite =
let l :: Url
l = Url
"deb http://security.debian.org/debian-security " forall a. [a] -> [a] -> [a]
++ Url
securitysuite forall a. [a] -> [a] -> [a]
++ Url
" " forall a. [a] -> [a] -> [a]
++ [Url] -> Url
unwords [Url]
stdSections
in [Url
l, ShowS
srcLine Url
l]
| Bool
otherwise = []
where
securitysuite :: Url
securitysuite
| DebianSuite
suite forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Url -> DebianSuite
Stable [Url]
releasesusingoldname =
DebianSuite -> Url
showSuite DebianSuite
suite forall a. [a] -> [a] -> [a]
++ Url
"/updates"
| Bool
otherwise = DebianSuite -> Url
showSuite DebianSuite
suite forall a. [a] -> [a] -> [a]
++ Url
"-security"
releasesusingoldname :: [Url]
releasesusingoldname = [Url
"jessie", Url
"buster", Url
"stretch"]
stdSourcesList :: Property Debian
stdSourcesList :: Property Debian
stdSourcesList = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
"standard sources.list" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w Maybe System
o -> case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_)) ->
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w forall a b. (a -> b) -> a -> b
$ DebianSuite -> Property Debian
stdSourcesListFor DebianSuite
suite
Maybe System
_ -> HasCallStack => Propellor Result
unsupportedOS'
stdSourcesListFor :: DebianSuite -> Property Debian
stdSourcesListFor :: DebianSuite -> Property Debian
stdSourcesListFor DebianSuite
suite = DebianSuite -> [SourcesGenerator] -> Property Debian
stdSourcesList' DebianSuite
suite []
stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
stdSourcesList' DebianSuite
suite [SourcesGenerator]
more = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror Url
desc forall a b. (a -> b) -> a -> b
$ \Url
u -> [Url] -> Property DebianLike
setSourcesList
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\SourcesGenerator
gen -> SourcesGenerator
gen DebianSuite
suite) (Url -> [SourcesGenerator]
generators Url
u))
where
generators :: Url -> [SourcesGenerator]
generators Url
u = [Url -> SourcesGenerator
binandsrc Url
u, SourcesGenerator
securityUpdates] forall a. [a] -> [a] -> [a]
++ [SourcesGenerator]
more
desc :: Url
desc = (Url
"standard sources.list for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Url
show DebianSuite
suite)
type PinPriority = Int
suiteAvailablePinned
:: DebianSuite
-> PinPriority
-> RevertableProperty Debian Debian
suiteAvailablePinned :: DebianSuite -> Int -> RevertableProperty Debian Debian
suiteAvailablePinned DebianSuite
s Int
pin = Property Debian
available forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Debian
unavailable
where
available :: Property Debian
available :: Property Debian
available = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Url
desc Bool
True) forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
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))
& Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasContent Url
prefFile (Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
"*" DebianSuite
s Int
pin)
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
setSourcesFile
unavailable :: Property Debian
unavailable :: Property Debian
unavailable = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Url
desc Bool
False) forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
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))
& Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Url
sourcesFile
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
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))
& Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Url
prefFile
setSourcesFile :: Property Debian
setSourcesFile :: Property Debian
setSourcesFile = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror (Bool -> Url
desc Bool
True) forall a b. (a -> b) -> a -> b
$ \Url
u ->
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (Bool -> Url
desc Bool
True) forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o -> case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
hostSuite) Architecture
_))
| DebianSuite
s forall a. Eq a => a -> a -> Bool
/= DebianSuite
hostSuite -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasContent Url
sourcesFile (Url -> [Url]
sources Url
u)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
Maybe System
_ -> Propellor Result
noChange
sources :: Url -> [Url]
sources Url
u = [Url] -> [Url]
dropBackports forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\SourcesGenerator
gen -> SourcesGenerator
gen DebianSuite
s) (Url -> [SourcesGenerator]
generators Url
u)
where
dropBackports :: [Url] -> [Url]
dropBackports
| Url
"-backports" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (DebianSuite -> Url
showSuite DebianSuite
s) = forall a. a -> a
id
| Bool
otherwise = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf Url
"-backports")
generators :: Url -> [SourcesGenerator]
generators Url
u = [Url -> SourcesGenerator
binandsrc Url
u, SourcesGenerator
securityUpdates]
prefFile :: Url
prefFile = Url
"/etc/apt/preferences.d/20" forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Url
".pref"
sourcesFile :: Url
sourcesFile = Url
"/etc/apt/sources.list.d/" forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Url
".list"
desc :: Bool -> Url
desc Bool
True = Url
"Debian " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Url
" pinned, priority " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Url
show Int
pin
desc Bool
False = Url
"Debian " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Url
" not pinned"
setSourcesList :: [Line] -> Property DebianLike
setSourcesList :: [Url] -> Property DebianLike
setSourcesList [Url]
ls = Url
sourcesList Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [Url]
ls forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
setSourcesListD :: [Line] -> FilePath -> Property DebianLike
setSourcesListD :: [Url] -> Url -> Property DebianLike
setSourcesListD [Url]
ls Url
basename = Url
f Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [Url]
ls forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
where
f :: Url
f = Url
"/etc/apt/sources.list.d/" forall a. [a] -> [a] -> [a]
++ Url
basename forall a. [a] -> [a] -> [a]
++ Url
".list"
runApt :: [String] -> UncheckedProperty DebianLike
runApt :: [Url] -> UncheckedProperty DebianLike
runApt [Url]
ps = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
-> [Url]
-> [(Url, Url)]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdPropertyEnv Url
"apt-get" [Url]
ps [(Url, Url)]
noninteractiveEnv
noninteractiveEnv :: [(String, String)]
noninteractiveEnv :: [(Url, Url)]
noninteractiveEnv =
[ (Url
"DEBIAN_FRONTEND", Url
"noninteractive")
, (Url
"APT_LISTCHANGES_FRONTEND", Url
"none")
]
update :: Property DebianLike
update :: Property DebianLike
update = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Url
desc forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
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 DebianLike
pendingConfigured
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 DebianLike
aptupdate
where
desc :: Url
desc = Url
"apt update"
aptupdate :: Property DebianLike
aptupdate :: Property DebianLike
aptupdate = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o -> case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_))
| Bool -> Bool
not (DebianSuite -> Bool
isStable DebianSuite
suite) -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
[Url] -> UncheckedProperty DebianLike
runApt [Url
"update", Url
"--allow-releaseinfo-change"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
Maybe System
_ -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
[Url] -> UncheckedProperty DebianLike
runApt [Url
"update"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
upgrade :: Property DebianLike
upgrade :: Property DebianLike
upgrade = Url -> Property DebianLike
upgrade' Url
"dist-upgrade"
upgrade' :: String -> Property DebianLike
upgrade' :: Url -> Property DebianLike
upgrade' Url
p = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Url
"apt " forall a. [a] -> [a] -> [a]
++ Url
p) forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
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 DebianLike
pendingConfigured
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))
& [Url] -> UncheckedProperty DebianLike
runApt [Url
"-y", Url
p]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
safeUpgrade :: Property DebianLike
safeUpgrade :: Property DebianLike
safeUpgrade = Url -> Property DebianLike
upgrade' Url
"upgrade"
pendingConfigured :: Property DebianLike
pendingConfigured :: Property DebianLike
pendingConfigured = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
Url
-> [Url]
-> [(Url, Url)]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdPropertyEnv Url
"dpkg" [Url
"--configure", Url
"--pending"] [(Url, Url)]
noninteractiveEnv
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall p. IsProp p => p -> Url -> p
`describe` Url
"dpkg configured pending"
type Package = String
installed :: [Package] -> Property DebianLike
installed :: [Url] -> Property DebianLike
installed = [Url] -> [Url] -> Property DebianLike
installed' [Url
"-y"]
installedMin :: [Package] -> Property DebianLike
installedMin :: [Url] -> Property DebianLike
installedMin = [Url] -> [Url] -> Property DebianLike
installed' [Url
"--no-install-recommends", Url
"-y"]
installed' :: [String] -> [Package] -> Property DebianLike
installed' :: [Url] -> [Url] -> Property DebianLike
installed' [Url]
params [Url]
ps = Property DebianLike -> Property DebianLike
robustly forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Url] -> IO Bool
isInstalled' [Url]
ps) UncheckedProperty DebianLike
go
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords (Url
"apt installed"forall a. a -> [a] -> [a]
:[Url]
ps)
where
go :: UncheckedProperty DebianLike
go = [Url] -> UncheckedProperty DebianLike
runApt ([Url]
params forall a. [a] -> [a] -> [a]
++ [Url
"install"] forall a. [a] -> [a] -> [a]
++ [Url]
ps)
backportInstalled :: [Package] -> Property Debian
backportInstalled :: [Url] -> Property Debian
backportInstalled = [Url] -> [Url] -> Property Debian
backportInstalled' [Url
"-y"]
backportInstalledMin :: [Package] -> Property Debian
backportInstalledMin :: [Url] -> Property Debian
backportInstalledMin = [Url] -> [Url] -> Property Debian
backportInstalled' [Url
"--no-install-recommends", Url
"-y"]
backportInstalled' :: [String] -> [Package] -> Property Debian
backportInstalled' :: [Url] -> [Url] -> Property Debian
backportInstalled' [Url]
params [Url]
ps = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w Maybe System
o -> case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_)) -> case DebianSuite -> Maybe Url
backportSuite DebianSuite
suite of
Maybe Url
Nothing -> HasCallStack => Propellor Result
unsupportedOS'
Just Url
bs -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w forall a b. (a -> b) -> a -> b
$
[Url] -> UncheckedProperty DebianLike
runApt ((Url
"install"forall a. a -> [a] -> [a]
:[Url]
params) forall a. [a] -> [a] -> [a]
++ ((forall a. [a] -> [a] -> [a]
++ Char
'/'forall a. a -> [a] -> [a]
:Url
bs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Url]
ps))
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
Maybe System
_ -> HasCallStack => Propellor Result
unsupportedOS'
where
desc :: Url
desc = [Url] -> Url
unwords (Url
"apt installed backport"forall a. a -> [a] -> [a]
:[Url]
ps)
removed :: [Package] -> Property DebianLike
removed :: [Url] -> Property DebianLike
removed [Url]
ps = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== InstallStatus
IsInstalled) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Url] -> IO [InstallStatus]
getInstallStatus [Url]
ps)
([Url] -> UncheckedProperty DebianLike
runApt ([Url
"-y", Url
"remove"] forall a. [a] -> [a] -> [a]
++ [Url]
ps))
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords (Url
"apt removed"forall a. a -> [a] -> [a]
:[Url]
ps)
buildDep :: [Package] -> Property DebianLike
buildDep :: [Url] -> Property DebianLike
buildDep [Url]
ps = Property DebianLike -> Property DebianLike
robustly forall a b. (a -> b) -> a -> b
$ UncheckedProperty DebianLike
go
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords (Url
"apt build-dep"forall a. a -> [a] -> [a]
:[Url]
ps)
where
go :: UncheckedProperty DebianLike
go = [Url] -> UncheckedProperty DebianLike
runApt forall a b. (a -> b) -> a -> b
$ [Url
"-y", Url
"build-dep"] forall a. [a] -> [a] -> [a]
++ [Url]
ps
buildDepIn :: FilePath -> Property DebianLike
buildDepIn :: Url -> Property DebianLike
buildDepIn Url
dir = UncheckedProperty DebianLike
go
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Url] -> Property DebianLike
installedMin [Url
"devscripts", Url
"equivs"]
where
go :: UncheckedProperty DebianLike
go :: UncheckedProperty DebianLike
go = forall i. Property i -> UncheckedProperty i
unchecked forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property (Url
"build-dep in " forall a. [a] -> [a] -> [a]
++ Url
dir) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Url -> (Url -> m a) -> m a
withTmpDir Url
"build-dep" forall a b. (a -> b) -> a -> b
$ \Url
tmpdir -> do
Bool -> Result
cmdResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Url
-> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
boolSystem' Url
"mk-build-deps"
[ Url -> CommandParam
File forall a b. (a -> b) -> a -> b
$ Url
dir Url -> ShowS
</> Url
"debian" Url -> ShowS
</> Url
"control"
, Url -> CommandParam
Param Url
"--install"
, Url -> CommandParam
Param Url
"--tool"
, Url -> CommandParam
Param Url
"apt-get -y --no-install-recommends"
] (\CreateProcess
p -> CreateProcess
p { cwd :: Maybe Url
cwd = forall a. a -> Maybe a
Just Url
tmpdir })
type AptPackagePref = String
pinnedTo
:: [AptPackagePref]
-> [(DebianSuite, PinPriority)]
-> RevertableProperty Debian Debian
pinnedTo :: [Url] -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo [Url]
ps [(DebianSuite, Int)]
pins = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (\Url
p -> Url -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Url
p [(DebianSuite, Int)]
pins) [Url]
ps)
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords ((Url
"pinned to " forall a. [a] -> [a] -> [a]
++ Url
showSuites)forall a. a -> [a] -> [a]
:[Url]
ps)
where
showSuites :: Url
showSuites = forall a. [a] -> [[a]] -> [a]
intercalate Url
"," forall a b. (a -> b) -> a -> b
$ DebianSuite -> Url
showSuite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(DebianSuite, Int)]
pins
pinnedTo'
:: AptPackagePref
-> [(DebianSuite, PinPriority)]
-> RevertableProperty Debian Debian
pinnedTo' :: Url -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Url
p [(DebianSuite, Int)]
pins =
(forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
prefFile Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [Url]
prefs)
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> (forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Url
prefFile)
where
prefs :: [Url]
prefs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DebianSuite, Int) -> [Url] -> [Url]
step [] [(DebianSuite, Int)]
pins
step :: (DebianSuite, Int) -> [Url] -> [Url]
step (DebianSuite
suite, Int
pin) [Url]
ls = [Url]
ls forall a. [a] -> [a] -> [a]
++ Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
p DebianSuite
suite Int
pin forall a. [a] -> [a] -> [a]
++ [Url
""]
prefFile :: Url
prefFile = Url
"/etc/apt/preferences.d/10propellor_"
forall a. [a] -> [a] -> [a]
++ ShowS
File.configFileName Url
p Url -> ShowS
<.> Url
"pref"
robustly :: Property DebianLike -> Property DebianLike
robustly :: Property DebianLike -> Property DebianLike
robustly Property DebianLike
p = Property DebianLike
p forall x y. Combines x y => x -> y -> CombinedType x y
`fallback` (Property DebianLike
update forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
p)
isInstalled :: Package -> IO Bool
isInstalled :: Url -> IO Bool
isInstalled Url
p = [Url] -> IO Bool
isInstalled' [Url
p]
isInstalled' :: [Package] -> IO Bool
isInstalled' :: [Url] -> IO Bool
isInstalled' [Url]
ps = do
[InstallStatus]
is <- [Url] -> IO [InstallStatus]
getInstallStatus [Url]
ps
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== InstallStatus
IsInstalled) [InstallStatus]
is Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstallStatus]
is forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Url]
ps
data InstallStatus = IsInstalled | NotInstalled
deriving (Int -> InstallStatus -> ShowS
[InstallStatus] -> ShowS
InstallStatus -> Url
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [InstallStatus] -> ShowS
$cshowList :: [InstallStatus] -> ShowS
show :: InstallStatus -> Url
$cshow :: InstallStatus -> Url
showsPrec :: Int -> InstallStatus -> ShowS
$cshowsPrec :: Int -> InstallStatus -> ShowS
Show, InstallStatus -> InstallStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallStatus -> InstallStatus -> Bool
$c/= :: InstallStatus -> InstallStatus -> Bool
== :: InstallStatus -> InstallStatus -> Bool
$c== :: InstallStatus -> InstallStatus -> Bool
Eq)
getInstallStatus :: [Package] -> IO [InstallStatus]
getInstallStatus :: [Url] -> IO [InstallStatus]
getInstallStatus [Url]
ps = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Url -> Maybe InstallStatus
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> [Url]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Url
policy
where
parse :: Url -> Maybe InstallStatus
parse Url
l
| Url
"Installed: (none)" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Url
l = forall a. a -> Maybe a
Just InstallStatus
NotInstalled
| Url
"Installed: " forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Url
l = forall a. a -> Maybe a
Just InstallStatus
IsInstalled
| Bool
otherwise = forall a. Maybe a
Nothing
policy :: IO Url
policy = do
[(Url, Url)]
environ <- forall k v. Eq k => k -> v -> [(k, v)] -> [(k, v)]
addEntry Url
"LANG" Url
"C" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(Url, Url)]
getEnvironment
Url -> [Url] -> Maybe [(Url, Url)] -> IO Url
readProcessEnv Url
"apt-cache" (Url
"policy"forall a. a -> [a] -> [a]
:[Url]
ps) (forall a. a -> Maybe a
Just [(Url, Url)]
environ)
autoRemove :: Property DebianLike
autoRemove :: Property DebianLike
autoRemove = [Url] -> UncheckedProperty DebianLike
runApt [Url
"-y", Url
"autoremove"]
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
forall p. IsProp p => p -> Url -> p
`describe` Url
"apt autoremove"
unattendedUpgrades :: RevertableProperty DebianLike DebianLike
unattendedUpgrades :: RevertableProperty DebianLike DebianLike
unattendedUpgrades = Property DebianLike
enable forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
disable
where
enable :: CombinedType
(CombinedType (Property DebianLike) (Property DebianLike))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
enable = Bool -> Property DebianLike
setup Bool
True
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Url -> Property DebianLike
Service.running Url
"cron"
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
configure
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Url
"/etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist"
disable :: Property DebianLike
disable = Bool -> Property DebianLike
setup Bool
False
setup :: Bool -> Property DebianLike
setup Bool
enabled = (if Bool
enabled then [Url] -> Property DebianLike
installed else [Url] -> Property DebianLike
removed) [Url
"unattended-upgrades"]
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Url -> [(Url, Url, Url)] -> Property DebianLike
reConfigure Url
"unattended-upgrades"
[(Url
"unattended-upgrades/enable_auto_updates" , Url
"boolean", Url
v)]
forall p. IsProp p => p -> Url -> p
`describe` (Url
"unattended upgrades " forall a. [a] -> [a] -> [a]
++ Url
v)
where
v :: Url
v
| Bool
enabled = Url
"true"
| Bool
otherwise = Url
"false"
configure :: Property DebianLike
configure :: Property DebianLike
configure = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Url
"unattended upgrades configured" forall a b. (a -> b) -> a -> b
$ Props
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
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 DebianLike
enableupgrading
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))
& Url
unattendedconfig Url
-> Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.containsLine` Url
"Unattended-Upgrade::Mail \"root\";"
where
enableupgrading :: Property DebianLike
enableupgrading :: Property DebianLike
enableupgrading = forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
"unattended upgrades configured" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o ->
case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_))
| Bool -> Bool
not (DebianSuite -> Bool
isStable DebianSuite
suite) -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
Url
unattendedconfig
Url
-> Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.containsLine`
(Url
"Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="forall a. [a] -> [a] -> [a]
++DebianSuite -> Url
showSuite DebianSuite
suiteforall a. [a] -> [a] -> [a]
++Url
"\"; };")
Maybe System
_ -> Propellor Result
noChange
unattendedconfig :: Url
unattendedconfig = Url
"/etc/apt/apt.conf.d/50unattended-upgrades"
periodicUpdates :: Property DebianLike
periodicUpdates :: Property DebianLike
periodicUpdates = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
"/etc/apt/apt.conf.d/02periodic" Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent`
[ Url
"APT::Periodic::Enable \"1\";"
, Url
"APT::Periodic::Update-Package-Lists \"1\";"
, Url
"APT::Periodic::Download-Upgradeable-Packages \"1\";"
, Url
"APT::Periodic::Verbose \"1\";"
]
type DebconfTemplate = String
type DebconfTemplateType = String
type DebconfTemplateValue = String
reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
reConfigure :: Url -> [(Url, Url, Url)] -> Property DebianLike
reConfigure Url
package [(Url, Url, Url)]
vals = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
reconfigure
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
setselections
forall p. IsProp p => p -> Url -> p
`describe` (Url
"reconfigure " forall a. [a] -> [a] -> [a]
++ Url
package)
where
setselections :: Property DebianLike
setselections :: Property DebianLike
setselections = forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property Url
"preseed" forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Url, Url, Url)]
vals
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$
forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
(Url -> [Url] -> CreateProcess
proc Url
"debconf-set-selections" []) forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Url, Url, Url)]
vals forall a b. (a -> b) -> a -> b
$ \(Url
tmpl, Url
tmpltype, Url
value) ->
Handle -> Url -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ [Url] -> Url
unwords [Url
package, Url
tmpl, Url
tmpltype, Url
value]
Handle -> IO ()
hClose Handle
h
reconfigure :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
reconfigure = Url
-> [Url]
-> [(Url, Url)]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdPropertyEnv Url
"dpkg-reconfigure" [Url
"-fnone", Url
package] [(Url, Url)]
noninteractiveEnv
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
serviceInstalledRunning :: Package -> Property DebianLike
serviceInstalledRunning :: Url -> Property DebianLike
serviceInstalledRunning Url
svc = Url -> Property DebianLike
Service.running Url
svc forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Url] -> Property DebianLike
installed [Url
svc]
data AptKey = AptKey
{ AptKey -> Url
keyname :: String
, AptKey -> Url
pubkey :: String
}
trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
trustsKey AptKey
k = AptKey -> Property DebianLike
trustsKey' AptKey
k forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> AptKey -> Property DebianLike
untrustKey AptKey
k
trustsKey' :: AptKey -> Property DebianLike
trustsKey' :: AptKey -> Property DebianLike
trustsKey' AptKey
k = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Url -> IO Bool
doesFileExist Url
f) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property Url
desc forall a b. (a -> b) -> a -> b
$ IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ do
forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
(Url -> [Url] -> CreateProcess
proc Url
"apt-key" [Url
"--keyring", Url
f, Url
"add", Url
"-"]) forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Handle -> Url -> IO ()
hPutStr Handle
h (AptKey -> Url
pubkey AptKey
k)
Handle -> IO ()
hClose Handle
h
Url -> IO ()
nukeFile forall a b. (a -> b) -> a -> b
$ Url
f forall a. [a] -> [a] -> [a]
++ Url
"~"
where
desc :: Url
desc = Url
"apt trusts key " forall a. [a] -> [a] -> [a]
++ AptKey -> Url
keyname AptKey
k
f :: Url
f = AptKey -> Url
aptKeyFile AptKey
k
untrustKey :: AptKey -> Property DebianLike
untrustKey :: AptKey -> Property DebianLike
untrustKey = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent forall b c a. (b -> c) -> (a -> b) -> a -> c
. AptKey -> Url
aptKeyFile
aptKeyFile :: AptKey -> FilePath
aptKeyFile :: AptKey -> Url
aptKeyFile AptKey
k = Url
"/etc/apt/trusted.gpg.d" Url -> ShowS
</> AptKey -> Url
keyname AptKey
k forall a. [a] -> [a] -> [a]
++ Url
".gpg"
cacheCleaned :: Property DebianLike
cacheCleaned :: Property DebianLike
cacheCleaned = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
-> [Url]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty Url
"apt-get" [Url
"clean"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> Url -> p
`describe` Url
"apt cache cleaned"
hasForeignArch :: String -> Property DebianLike
hasForeignArch :: Url -> Property DebianLike
hasForeignArch Url
arch = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
notAdded (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
add forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
update)
forall p. IsProp p => p -> Url -> p
`describe` (Url
"dpkg has foreign architecture " forall a. [a] -> [a] -> [a]
++ Url
arch)
where
notAdded :: IO Bool
notAdded = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Url
arch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> [Url]
lines) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Url -> [Url] -> IO Url
readProcess Url
"dpkg" [Url
"--print-foreign-architectures"]
add :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
add = Url
-> [Url]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty Url
"dpkg" [Url
"--add-architecture", Url
arch]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
noPDiffs :: Property DebianLike
noPDiffs :: Property DebianLike
noPDiffs = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ Url
"/etc/apt/apt.conf.d/20pdiffs" Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent`
[ Url
"Acquire::PDiffs \"false\";" ]
suitePin :: DebianSuite -> String
suitePin :: DebianSuite -> Url
suitePin DebianSuite
s = DebianSuite -> Url
prefix DebianSuite
s forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s
where
prefix :: DebianSuite -> Url
prefix (Stable Url
_) = Url
"n="
prefix DebianSuite
_ = Url
"a="
suitePinBlock :: AptPackagePref -> DebianSuite -> PinPriority -> [Line]
suitePinBlock :: Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
p DebianSuite
suite Int
pin =
[ Url
"Explanation: This file added by propellor"
, Url
"Package: " forall a. [a] -> [a] -> [a]
++ Url
p
, Url
"Pin: release " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
suitePin DebianSuite
suite
, Url
"Pin-Priority: " forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Url
val Int
pin
]
dpkgStatus :: FilePath
dpkgStatus :: Url
dpkgStatus = Url
"/var/lib/dpkg/status"
proxy :: Url -> Property (HasInfo + DebianLike)
proxy :: Url -> Property (HasInfo + DebianLike)
proxy Url
u = forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty (Url -> Property DebianLike
proxy' Url
u) (Url -> Info
proxyInfo Url
u)
where
proxyInfo :: Url -> Info
proxyInfo = forall v. IsInfo v => v -> Info
toInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. v -> InfoVal v
InfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> HostAptProxy
HostAptProxy
proxy' :: Url -> Property DebianLike
proxy' :: Url -> Property DebianLike
proxy' Url
u = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
Url
"/etc/apt/apt.conf.d/20proxy" Url
-> [Url]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent`
[ Url
"Acquire::HTTP::Proxy \"" forall a. [a] -> [a] -> [a]
++ Url
u forall a. [a] -> [a] -> [a]
++ Url
"\";" ]
forall p. IsProp p => p -> Url -> p
`describe` Url
desc
where
desc :: Url
desc = (Url
u forall a. [a] -> [a] -> [a]
++ Url
" apt proxy selected")
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher = Url -> Property (HasInfo + DebianLike)
proxy Url
"http://localhost:3142"
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Url -> Property DebianLike
serviceInstalledRunning Url
"apt-cacher-ng"
forall p. IsProp p => p -> Url -> p
`describe` Url
"apt uses local apt cacher"