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