{-# 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 -> Release
forall a.
(Int -> a -> ShowS) -> (a -> Release) -> ([a] -> ShowS) -> Show a
showList :: [HostMirror] -> ShowS
$cshowList :: [HostMirror] -> ShowS
show :: HostMirror -> Release
$cshow :: HostMirror -> Release
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 -> Release
forall a.
(Int -> a -> ShowS) -> (a -> Release) -> ([a] -> ShowS) -> Show a
showList :: [HostAptProxy] -> ShowS
$cshowList :: [HostAptProxy] -> ShowS
show :: HostAptProxy -> Release
$cshow :: HostAptProxy -> Release
showsPrec :: Int -> HostAptProxy -> ShowS
$cshowsPrec :: Int -> HostAptProxy -> ShowS
Show, Typeable)

-- | Indicate host's preferred apt mirror
mirror :: Url -> Property (HasInfo + UnixLike)
mirror :: Release
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
mirror Release
u = forall v.
IsInfo v =>
Release
-> v
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty (Release
u forall a. [a] -> [a] -> [a]
++ Release
" apt mirror selected")
	     (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
	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 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
_) ->
			forall a. HasCallStack => Release -> a
error (Release
"no Apt mirror defined for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Release
show Distribution
dist)
		(Maybe System, Maybe HostMirror)
_ -> 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 = 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 :: Release -> (Release -> Property DebianLike) -> Property DebianLike
withMirror Release
desc Release -> Property DebianLike
mkp = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Release
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
	Release
u <- Propellor Release
getMirror
	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) = forall a. a -> Maybe a
Just (Release
s forall a. [a] -> [a] -> [a]
++ Release
"-backports")
backportSuite DebianSuite
_ = forall a. Maybe a
Nothing

stableUpdatesSuite :: DebianSuite -> Maybe String
stableUpdatesSuite :: DebianSuite -> Maybe Release
stableUpdatesSuite (Stable Release
s) = forall a. a -> Maybe a
Just (Release
s forall a. [a] -> [a] -> [a]
++ Release
"-updates")
stableUpdatesSuite DebianSuite
_ = 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 forall a b. (a -> b) -> a -> b
$
	[Release
"deb", Release
url, Release
suite] 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 forall a b. (a -> b) -> a -> b
$ Release
"deb-src" 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"] forall a. [a] -> [a] -> [a]
++ case DebianSuite
s of
	Stable Release
r | Release
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Release]
oldstables -> []
	-- Suite added in debian bookworm.
	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 = forall a. [Maybe a] -> [a]
catMaybes
	[ forall a. a -> Maybe a
Just Release
l
	, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
srcLine Release
l
	, Maybe Release
sul
	, ShowS
srcLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Release
sul
	, Maybe Release
bl
	, ShowS
srcLine 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
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Release -> Release -> [Release] -> Release
debLine Release
bs Release
url (DebianSuite -> [Release]
stdSections DebianSuite
suite)
	-- formerly known as 'volatile'
	sul :: Maybe Release
sul = do
		Release
sus <- DebianSuite -> Maybe Release
stableUpdatesSuite DebianSuite
suite
		forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> DebianSuite -> [Release]
binandsrc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor Release
getMirror

-- | Only available for Stable suites, not for Testing or Unstable.
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 " forall a. [a] -> [a] -> [a]
++ Release
securitysuite forall a. [a] -> [a] -> [a]
++ Release
" " 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Release -> DebianSuite
Stable [Release]
releasesusingoldname =
			DebianSuite -> Release
showSuite DebianSuite
suite forall a. [a] -> [a] -> [a]
++ Release
"/updates"
		| Bool
otherwise = DebianSuite -> Release
showSuite DebianSuite
suite forall a. [a] -> [a] -> [a]
++ Release
"-security"
	releasesusingoldname :: [Release]
releasesusingoldname = [Release
"jessie", Release
"buster", Release
"stretch"]

-- | Makes sources.list have a standard content using the Debian mirror CDN
-- (or other host specified using the `mirror` property), with the
-- Debian suite configured by the os.
stdSourcesList :: Property Debian
stdSourcesList :: Property Debian
stdSourcesList = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Release
"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 -> [DebianSuite -> [Release]] -> Property Debian
stdSourcesList' DebianSuite
suite []

-- | Adds additional sources.list generators.
--
-- Note that if a Property needs to enable an apt source, it's better
-- to do so via a separate file in </etc/apt/sources.list.d/>
stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
stdSourcesList' :: DebianSuite -> [DebianSuite -> [Release]] -> Property Debian
stdSourcesList' DebianSuite
suite [DebianSuite -> [Release]]
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
$
	Release -> (Release -> Property DebianLike) -> Property DebianLike
withMirror Release
desc forall a b. (a -> b) -> a -> b
$ \Release
u -> [Release] -> Property DebianLike
setSourcesList
		(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] forall a. [a] -> [a] -> [a]
++ [DebianSuite -> [Release]]
more
	desc :: Release
desc = (Release
"standard sources.list for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Release
show DebianSuite
suite)

type PinPriority = Int

-- | Adds an apt source for a suite, and pins that suite to a given pin value
-- (see apt_preferences(5)).  Revert to drop the source and unpin the suite.
--
-- If the requested suite is the host's OS suite, the suite is pinned, but no
-- source is added.  That apt source should already be available, or you can use
-- a property like 'Apt.stdSourcesList'.
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 =>
Release
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Release
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))
& 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)
		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 =>
Release
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Release
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))
& Release
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Release
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))
& Release
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Release
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
$ Release -> (Release -> Property DebianLike) -> Property DebianLike
withMirror (Bool -> Release
desc Bool
True) forall a b. (a -> b) -> a -> b
$ \Release
u ->
		forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (Bool -> Release
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
$
					Release
-> [Release]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasContent Release
sourcesFile (Release -> [Release]
sources Release
u)
					forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
			Maybe System
_ -> Propellor Result
noChange

	-- Unless we are pinning a backports suite, filter out any backports
	-- sources that were added by our generators.  The user probably doesn't
	-- want those to be pinned to the same value
	sources :: Release -> [Release]
sources Release
u = [Release] -> [Release]
dropBackports forall a b. (a -> b) -> a -> b
$ 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" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (DebianSuite -> Release
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 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" forall a. [a] -> [a] -> [a]
++ DebianSuite -> Release
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Release
".pref"
	sourcesFile :: Release
sourcesFile = Release
"/etc/apt/sources.list.d/" forall a. [a] -> [a] -> [a]
++ DebianSuite -> Release
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Release
".list"

	desc :: Bool -> Release
desc Bool
True = Release
"Debian " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Release
showSuite DebianSuite
s forall a. [a] -> [a] -> [a]
++ Release
" pinned, priority " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Release
show Int
pin
	desc Bool
False = Release
"Debian " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Release
showSuite DebianSuite
s 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 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 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/" forall a. [a] -> [a] -> [a]
++ Release
basename forall a. [a] -> [a] -> [a]
++ Release
".list"

runApt :: [String] -> UncheckedProperty DebianLike
runApt :: [Release] -> UncheckedProperty DebianLike
runApt [Release]
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
$ 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")
		]

-- | Have apt update its lists of packages, but without upgrading anything.
update :: Property DebianLike
update :: Property DebianLike
update = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Release
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 :: Release
desc = Release
"apt update"
	aptupdate :: Property DebianLike
	aptupdate :: Property DebianLike
aptupdate = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Release
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
$
				-- rolling suites' release info can change
				[Release] -> UncheckedProperty DebianLike
runApt [Release
"update", Release
"--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
$ 
			[Release] -> UncheckedProperty DebianLike
runApt [Release
"update"]
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

-- | Have apt upgrade packages, adding new packages and removing old as
-- necessary. Often used in combination with the `update` property.
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 = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Release
"apt " forall a. [a] -> [a] -> [a]
++ Release
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))
& [Release] -> UncheckedProperty DebianLike
runApt [Release
"-y", Release
p]
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

-- | Have apt upgrade packages, but never add new packages or remove
-- old packages. Not suitable for upgrading acrocess major versions
-- of the distribution.
safeUpgrade :: Property DebianLike
safeUpgrade :: Property DebianLike
safeUpgrade = Release -> Property DebianLike
upgrade' Release
"upgrade"

-- | Have dpkg try to configure any packages that are not fully configured.
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
$
	Release
-> [Release]
-> [(Release, Release)]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdPropertyEnv Release
"dpkg" [Release
"--configure", Release
"--pending"] [(Release, Release)]
noninteractiveEnv
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		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"]

-- | Minimal install of package, without recommends.
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 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
<$> [Release] -> IO Bool
isInstalled' [Release]
ps) UncheckedProperty DebianLike
go
	forall p. IsProp p => p -> Release -> p
`describe` [Release] -> Release
unwords (Release
"apt installed"forall a. a -> [a] -> [a]
:[Release]
ps)
  where
	go :: UncheckedProperty DebianLike
go = [Release] -> UncheckedProperty DebianLike
runApt ([Release]
params forall a. [a] -> [a] -> [a]
++ [Release
"install"] forall a. [a] -> [a] -> [a]
++ [Release]
ps)

-- | Install packages from the stable-backports suite.
--
-- If installing the backport requires installing versions of a package's
-- dependencies from stable-backports too, you will need to include those
-- dependencies in the list of packages passed to this function.
backportInstalled :: [Package] -> Property Debian
backportInstalled :: [Release] -> Property Debian
backportInstalled = [Release] -> [Release] -> Property Debian
backportInstalled' [Release
"-y"]

-- | Minimal install from the stable-backports suite, without recommends.
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 = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Release
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 Release
backportSuite DebianSuite
suite of
		Maybe Release
Nothing -> HasCallStack => Propellor Result
unsupportedOS'
		Just Release
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
$
			[Release] -> UncheckedProperty DebianLike
runApt ((Release
"install"forall a. a -> [a] -> [a]
:[Release]
params) forall a. [a] -> [a] -> [a]
++ ((forall a. [a] -> [a] -> [a]
++ Char
'/'forall a. a -> [a] -> [a]
:Release
bs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Release]
ps))
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Release -> Property i
`changesFile` Release
dpkgStatus
	Maybe System
_ -> HasCallStack => Propellor Result
unsupportedOS'
  where
	desc :: Release
desc = [Release] -> Release
unwords (Release
"apt installed backport"forall a. a -> [a] -> [a]
:[Release]
ps)

removed :: [Package] -> Property DebianLike
removed :: [Release] -> Property DebianLike
removed [Release]
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
<$> [Release] -> IO [InstallStatus]
getInstallStatus [Release]
ps)
	([Release] -> UncheckedProperty DebianLike
runApt ([Release
"-y", Release
"remove"] forall a. [a] -> [a] -> [a]
++ [Release]
ps))
	forall p. IsProp p => p -> Release -> p
`describe` [Release] -> Release
unwords (Release
"apt removed"forall a. a -> [a] -> [a]
:[Release]
ps)

buildDep :: [Package] -> Property DebianLike
buildDep :: [Release] -> Property DebianLike
buildDep [Release]
ps = Property DebianLike -> Property DebianLike
robustly forall a b. (a -> b) -> a -> b
$ UncheckedProperty DebianLike
go
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Release -> Property i
`changesFile` Release
dpkgStatus
	forall p. IsProp p => p -> Release -> p
`describe` [Release] -> Release
unwords (Release
"apt build-dep"forall a. a -> [a] -> [a]
:[Release]
ps)
  where
	go :: UncheckedProperty DebianLike
go = [Release] -> UncheckedProperty DebianLike
runApt forall a b. (a -> b) -> a -> b
$ [Release
"-y", Release
"build-dep"] forall a. [a] -> [a] -> [a]
++ [Release]
ps

-- | Installs the build deps for the source package unpacked
-- in the specifed directory, with a dummy package also
-- installed so that autoRemove won't remove them.
buildDepIn :: FilePath -> Property DebianLike
buildDepIn :: Release -> Property DebianLike
buildDepIn Release
dir = UncheckedProperty DebianLike
go
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Release -> Property i
`changesFile` Release
dpkgStatus
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Release] -> Property DebianLike
installedMin [Release
"devscripts", Release
"equivs"]
  where
	-- mk-build-deps may leave files behind sometimes, eg on failure,
	-- so run it in a temp directory, passing the path to the control
	-- file
	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 =>
Release -> Propellor Result -> Property (MetaTypes metatypes)
property (Release
"build-dep in " forall a. [a] -> [a] -> [a]
++ Release
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) =>
Release -> (Release -> m a) -> m a
withTmpDir Release
"build-dep" forall a b. (a -> b) -> a -> b
$ \Release
tmpdir -> do
			Bool -> Result
cmdResult 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 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 :: Maybe Release
cwd = forall a. a -> Maybe a
Just Release
tmpdir })

-- | The name of a package, a glob to match the names of packages, or a regexp
-- surrounded by slashes to match the names of packages.  See
-- apt_preferences(5), "Regular expressions and glob(7) syntax"
type AptPackagePref = String

-- | Pins a list of packages, package wildcards and/or regular expressions to a
-- list of suites and corresponding pin priorities (see apt_preferences(5)).
-- Revert to unpin.
--
-- Each package, package wildcard or regular expression will be pinned to all of
-- the specified suites.
--
-- Note that this will have no effect unless there is an apt source for each of
-- the suites.  One way to add an apt source is 'Apt.suiteAvailablePinned'.
--
-- For example, to obtain Emacs Lisp addon packages not present in your release
-- of Debian from testing, falling back to sid if they're not available in
-- testing, you could use
--
--  > & Apt.suiteAvailablePinned Testing (-10)
--  > & Apt.suiteAvailablePinned Unstable (-10)
--  > & ["elpa-*"] `Apt.pinnedTo` [(Testing, 100), (Unstable, 50)]
pinnedTo
	:: [AptPackagePref]
	-> [(DebianSuite, PinPriority)]
	-> RevertableProperty Debian Debian
pinnedTo :: [Release]
-> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo [Release]
ps [(DebianSuite, Int)]
pins = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (\Release
p -> Release -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Release
p [(DebianSuite, Int)]
pins) [Release]
ps)
	forall p. IsProp p => p -> Release -> p
`describe` [Release] -> Release
unwords ((Release
"pinned to " forall a. [a] -> [a] -> [a]
++ Release
showSuites)forall a. a -> [a] -> [a]
:[Release]
ps)
  where
	showSuites :: Release
showSuites = forall a. [a] -> [[a]] -> [a]
intercalate Release
"," forall a b. (a -> b) -> a -> b
$ DebianSuite -> Release
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' :: Release -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Release
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
$ Release
prefFile Release
-> [Release]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [Release]
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
$ Release
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent Release
prefFile)
  where
	prefs :: [Release]
prefs = 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 forall a. [a] -> [a] -> [a]
++ Release -> DebianSuite -> Int -> [Release]
suitePinBlock Release
p DebianSuite
suite Int
pin forall a. [a] -> [a] -> [a]
++ [Release
""]
	prefFile :: Release
prefFile = Release
"/etc/apt/preferences.d/10propellor_"
		forall a. [a] -> [a] -> [a]
++ ShowS
File.configFileName Release
p Release -> ShowS
<.> Release
"pref"

-- | Package installation may fail becuse the archive has changed.
-- Run an update in that case and retry.
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 :: 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
	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 [Release]
ps

data InstallStatus = IsInstalled | NotInstalled
	deriving (Int -> InstallStatus -> ShowS
[InstallStatus] -> ShowS
InstallStatus -> Release
forall a.
(Int -> a -> ShowS) -> (a -> Release) -> ([a] -> ShowS) -> Show a
showList :: [InstallStatus] -> ShowS
$cshowList :: [InstallStatus] -> ShowS
show :: InstallStatus -> Release
$cshow :: InstallStatus -> Release
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)

{- Returns the InstallStatus of packages that are installed
 - or known and not installed. If a package is not known at all to apt
 - or dpkg, it is not included in the list. -}
getInstallStatus :: [Package] -> IO [InstallStatus]
getInstallStatus :: [Release] -> IO [InstallStatus]
getInstallStatus [Release]
ps = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Release -> Maybe InstallStatus
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> [Release]
lines 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)" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Release
l = forall a. a -> Maybe a
Just InstallStatus
NotInstalled
		| Release
"Installed: " forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Release
l = forall a. a -> Maybe a
Just InstallStatus
IsInstalled
		| Bool
otherwise = forall a. Maybe a
Nothing
	policy :: IO Release
policy = do
		[(Release, Release)]
environ <- forall k v. Eq k => k -> v -> [(k, v)] -> [(k, v)]
addEntry Release
"LANG" Release
"C" 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"forall a. a -> [a] -> [a]
:[Release]
ps) (forall a. a -> Maybe a
Just [(Release, Release)]
environ)

autoRemove :: Property DebianLike
autoRemove :: Property DebianLike
autoRemove = [Release] -> UncheckedProperty DebianLike
runApt [Release
"-y", Release
"autoremove"]
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Release -> Property i
`changesFile` Release
dpkgStatus
	forall p. IsProp p => p -> Release -> p
`describe` Release
"apt autoremove"

-- | Enables unattended upgrades. Revert to disable.
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` Release -> Property DebianLike
Service.running Release
"cron"
		forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
configure
		-- work around http://bugs.debian.org/812380
		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"]
		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)]
		forall p. IsProp p => p -> Release -> p
`describe` (Release
"unattended upgrades " 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 = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Release
"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))
& 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 = forall {k} (metatypes :: k).
SingI metatypes =>
Release
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Release
"unattended upgrades configured" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o ->
			case Maybe System
o of
				-- the package defaults to only upgrading stable
				(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
$
						Release
unattendedconfig
							Release
-> Release
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.containsLine`
						(Release
"Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="forall a. [a] -> [a] -> [a]
++DebianSuite -> Release
showSuite DebianSuite
suiteforall a. [a] -> [a] -> [a]
++Release
"\"; };")
				Maybe System
_ -> Propellor Result
noChange
		unattendedconfig :: Release
unattendedconfig = Release
"/etc/apt/apt.conf.d/50unattended-upgrades"

-- | Enable periodic updates (but not upgrades), including download
-- of packages.
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
$ 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

-- | Preseeds debconf values and reconfigures the package so it takes
-- effect.
reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
reConfigure :: Release -> [(Release, Release, Release)] -> Property DebianLike
reConfigure Release
package [(Release, Release, Release)]
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 -> Release -> p
`describe` (Release
"reconfigure " forall a. [a] -> [a] -> [a]
++ Release
package)
  where
	setselections :: Property DebianLike
	setselections :: Property DebianLike
setselections = forall {k} (metatypes :: k).
SingI metatypes =>
Release -> Propellor Result -> Property (MetaTypes metatypes)
property Release
"preseed" forall a b. (a -> b) -> a -> b
$
		if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Release, Release, Release)]
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
					(Release -> [Release] -> CreateProcess
proc Release
"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_ [(Release, Release, Release)]
vals forall a b. (a -> b) -> a -> b
$ \(Release
tmpl, Release
tmpltype, Release
value) ->
							Handle -> Release -> IO ()
hPutStrLn Handle
h 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
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

-- | Ensures that a service is installed and running.
--
-- Assumes that there is a 1:1 mapping between service names and apt
-- package names.
serviceInstalledRunning :: Package -> Property DebianLike
serviceInstalledRunning :: Release -> Property DebianLike
serviceInstalledRunning Release
svc = Release -> Property DebianLike
Service.running Release
svc 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 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
<$> Release -> IO Bool
doesFileExist Release
f) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Release -> Propellor Result -> Property (MetaTypes metatypes)
property Release
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
		(Release -> [Release] -> CreateProcess
proc Release
"apt-key" [Release
"--keyring", Release
f, Release
"add", Release
"-"]) 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 forall a b. (a -> b) -> a -> b
$ Release
f forall a. [a] -> [a] -> [a]
++ Release
"~" -- gpg dropping
  where
	desc :: Release
desc = Release
"apt trusts key " 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 = 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
. Release
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent 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 forall a. [a] -> [a] -> [a]
++ Release
".gpg"

-- | Cleans apt's cache of downloaded packages to avoid using up disk
-- space.
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
$ Release
-> [Release]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty Release
"apt-get" [Release
"clean"]
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	forall p. IsProp p => p -> Release -> p
`describe` Release
"apt cache cleaned"

-- | Add a foreign architecture to dpkg and apt.
hasForeignArch :: String -> Property DebianLike
hasForeignArch :: Release -> Property DebianLike
hasForeignArch Release
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 -> Release -> p
`describe` (Release
"dpkg has foreign architecture " forall a. [a] -> [a] -> [a]
++ Release
arch)
  where
	notAdded :: IO Bool
notAdded = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Release
arch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> [Release]
lines) 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]
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

-- | Disable the use of PDiffs for machines with high-bandwidth connections.
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
$ 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 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: " forall a. [a] -> [a] -> [a]
++ Release
p
	, Release
"Pin: release " forall a. [a] -> [a] -> [a]
++ DebianSuite -> Release
suitePin DebianSuite
suite
	, Release
"Pin-Priority: " forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Release
val Int
pin
	]

dpkgStatus :: FilePath
dpkgStatus :: Release
dpkgStatus = Release
"/var/lib/dpkg/status"

-- | Set apt's proxy
proxy :: Url -> Property (HasInfo + DebianLike)
proxy :: Release -> Property (HasInfo + DebianLike)
proxy Release
u = 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 = 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
. Release -> HostAptProxy
HostAptProxy

proxy' :: Url -> Property DebianLike
proxy' :: Release -> Property DebianLike
proxy' Release
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
$
	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 \"" forall a. [a] -> [a] -> [a]
++ Release
u forall a. [a] -> [a] -> [a]
++ Release
"\";" ]
		forall p. IsProp p => p -> Release -> p
`describe` Release
desc
  where
	desc :: Release
desc = (Release
u forall a. [a] -> [a] -> [a]
++ Release
" apt proxy selected")

-- | Cause apt to proxy downloads via an apt cacher on localhost
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher = Release -> Property (HasInfo + DebianLike)
proxy Release
"http://localhost:3142"
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Release -> Property DebianLike
serviceInstalledRunning Release
"apt-cacher-ng"
	forall p. IsProp p => p -> Release -> p
`describe` Release
"apt uses local apt cacher"