{-# 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
/= :: HostMirror -> HostMirror -> Bool
$c/= :: HostMirror -> HostMirror -> Bool
== :: HostMirror -> HostMirror -> Bool
$c== :: HostMirror -> HostMirror -> Bool
Eq, Int -> HostMirror -> ShowS
[HostMirror] -> ShowS
HostMirror -> Url
(Int -> HostMirror -> ShowS)
-> (HostMirror -> Url)
-> ([HostMirror] -> ShowS)
-> Show HostMirror
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [HostMirror] -> ShowS
$cshowList :: [HostMirror] -> ShowS
show :: HostMirror -> Url
$cshow :: HostMirror -> Url
showsPrec :: Int -> HostMirror -> ShowS
$cshowsPrec :: Int -> HostMirror -> ShowS
Show, Typeable)

data HostAptProxy = HostAptProxy Url
	deriving (HostAptProxy -> HostAptProxy -> Bool
(HostAptProxy -> HostAptProxy -> Bool)
-> (HostAptProxy -> HostAptProxy -> Bool) -> Eq HostAptProxy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAptProxy -> HostAptProxy -> Bool
$c/= :: HostAptProxy -> HostAptProxy -> Bool
== :: HostAptProxy -> HostAptProxy -> Bool
$c== :: HostAptProxy -> HostAptProxy -> Bool
Eq, Int -> HostAptProxy -> ShowS
[HostAptProxy] -> ShowS
HostAptProxy -> Url
(Int -> HostAptProxy -> ShowS)
-> (HostAptProxy -> Url)
-> ([HostAptProxy] -> ShowS)
-> Show HostAptProxy
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [HostAptProxy] -> ShowS
$cshowList :: [HostAptProxy] -> ShowS
show :: HostAptProxy -> Url
$cshow :: HostAptProxy -> Url
showsPrec :: Int -> HostAptProxy -> ShowS
$cshowsPrec :: Int -> HostAptProxy -> ShowS
Show, Typeable)

-- | Indicate host's preferred apt mirror
mirror :: Url -> Property (HasInfo + UnixLike)
mirror :: Url -> Property (HasInfo + UnixLike)
mirror Url
u = Url -> InfoVal HostMirror -> Property (HasInfo + UnixLike)
forall v. IsInfo v => Url -> v -> Property (HasInfo + UnixLike)
pureInfoProperty (Url
u Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
" apt mirror selected")
	     (HostMirror -> InfoVal HostMirror
forall v. v -> InfoVal v
InfoVal (Url -> HostMirror
HostMirror Url
u))

getMirror :: Propellor Url
getMirror :: Propellor Url
getMirror = do
	Maybe HostMirror
mirrorInfo <- Propellor (Maybe HostMirror)
getMirrorInfo
	Maybe System
osInfo <- Propellor (Maybe System)
getOS
	Url -> Propellor Url
forall (m :: * -> *) a. Monad m => a -> m a
return (Url -> Propellor Url) -> Url -> Propellor Url
forall a b. (a -> b) -> a -> b
$ case (Maybe System
osInfo, Maybe HostMirror
mirrorInfo) of
		(Maybe System
_, Just (HostMirror Url
u)) -> Url
u
		(Just (System (Debian DebianKernel
_ DebianSuite
_) Architecture
_), Maybe HostMirror
_) ->
			Url
"http://deb.debian.org/debian"
		(Just (System (Buntish Url
_) Architecture
_), Maybe HostMirror
_) ->
			Url
"mirror://mirrors.ubuntu.com/"
		(Just (System Distribution
dist Architecture
_), Maybe HostMirror
_) ->
			ShowS
forall a. HasCallStack => Url -> a
error (Url
"no Apt mirror defined for " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Distribution -> Url
forall a. Show a => a -> Url
show Distribution
dist)
		(Maybe System, Maybe HostMirror)
_ -> ShowS
forall a. HasCallStack => Url -> a
error Url
"no Apt mirror defined for this host or OS"
  where
	getMirrorInfo :: Propellor (Maybe HostMirror)
	getMirrorInfo :: Propellor (Maybe HostMirror)
getMirrorInfo = 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 :: Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror Url
desc Url -> Property DebianLike
mkp = Url
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Url
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
	Url
u <- Propellor Url
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 (Url -> Property DebianLike
mkp Url
u)

sourcesList :: FilePath
sourcesList :: Url
sourcesList = Url
"/etc/apt/sources.list"

type Url = String
type Section = String

type SourcesGenerator = DebianSuite -> [Line]

showSuite :: DebianSuite -> String
showSuite :: DebianSuite -> Url
showSuite (Stable Url
s) = Url
s
showSuite DebianSuite
Testing = Url
"testing"
showSuite DebianSuite
Unstable = Url
"unstable"
showSuite DebianSuite
Experimental = Url
"experimental"

backportSuite :: DebianSuite -> Maybe String
backportSuite :: DebianSuite -> Maybe Url
backportSuite (Stable Url
s) = Url -> Maybe Url
forall a. a -> Maybe a
Just (Url
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"-backports")
backportSuite DebianSuite
_ = Maybe Url
forall a. Maybe a
Nothing

stableUpdatesSuite :: DebianSuite -> Maybe String
stableUpdatesSuite :: DebianSuite -> Maybe Url
stableUpdatesSuite (Stable Url
s) = Url -> Maybe Url
forall a. a -> Maybe a
Just (Url
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"-updates")
stableUpdatesSuite DebianSuite
_ = Maybe Url
forall a. Maybe a
Nothing

debLine :: String -> Url -> [Section] -> Line
debLine :: Url -> Url -> [Url] -> Url
debLine Url
suite Url
url [Url]
sections = [Url] -> Url
unwords ([Url] -> Url) -> [Url] -> Url
forall a b. (a -> b) -> a -> b
$
	[Url
"deb", Url
url, Url
suite] [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ [Url]
sections

srcLine :: Line -> Line
srcLine :: ShowS
srcLine Url
l = case Url -> [Url]
words Url
l of
	(Url
"deb":[Url]
rest) -> [Url] -> Url
unwords ([Url] -> Url) -> [Url] -> Url
forall a b. (a -> b) -> a -> b
$ Url
"deb-src" Url -> [Url] -> [Url]
forall a. a -> [a] -> [a]
: [Url]
rest
	[Url]
_ -> Url
""

stdSections :: [Section]
stdSections :: [Url]
stdSections = [Url
"main", Url
"contrib", Url
"non-free"]

binandsrc :: String -> SourcesGenerator
binandsrc :: Url -> SourcesGenerator
binandsrc Url
url DebianSuite
suite = [Maybe Url] -> [Url]
forall a. [Maybe a] -> [a]
catMaybes
	[ Url -> Maybe Url
forall a. a -> Maybe a
Just Url
l
	, Url -> Maybe Url
forall a. a -> Maybe a
Just (Url -> Maybe Url) -> Url -> Maybe Url
forall a b. (a -> b) -> a -> b
$ ShowS
srcLine Url
l
	, Maybe Url
sul
	, ShowS
srcLine ShowS -> Maybe Url -> Maybe Url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Url
sul
	, Maybe Url
bl
	, ShowS
srcLine ShowS -> Maybe Url -> Maybe Url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Url
bl
	]
  where
	l :: Url
l = Url -> Url -> [Url] -> Url
debLine (DebianSuite -> Url
showSuite DebianSuite
suite) Url
url [Url]
stdSections
	bl :: Maybe Url
bl = do
		Url
bs <- DebianSuite -> Maybe Url
backportSuite DebianSuite
suite
		Url -> Maybe Url
forall (m :: * -> *) a. Monad m => a -> m a
return (Url -> Maybe Url) -> Url -> Maybe Url
forall a b. (a -> b) -> a -> b
$ Url -> Url -> [Url] -> Url
debLine Url
bs Url
url [Url]
stdSections
	-- formerly known as 'volatile'
	sul :: Maybe Url
sul = do
		Url
sus <- DebianSuite -> Maybe Url
stableUpdatesSuite DebianSuite
suite
		Url -> Maybe Url
forall (m :: * -> *) a. Monad m => a -> m a
return (Url -> Maybe Url) -> Url -> Maybe Url
forall a b. (a -> b) -> a -> b
$ Url -> Url -> [Url] -> Url
debLine Url
sus Url
url [Url]
stdSections

stdArchiveLines :: Propellor SourcesGenerator
stdArchiveLines :: Propellor SourcesGenerator
stdArchiveLines = SourcesGenerator -> Propellor SourcesGenerator
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcesGenerator -> Propellor SourcesGenerator)
-> (Url -> SourcesGenerator) -> Url -> Propellor SourcesGenerator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> SourcesGenerator
binandsrc (Url -> Propellor SourcesGenerator)
-> Propellor Url -> Propellor SourcesGenerator
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor Url
getMirror

-- | Only available for Stable suites, not for Testing or Unstable.
securityUpdates :: SourcesGenerator
securityUpdates :: SourcesGenerator
securityUpdates DebianSuite
suite
	| DebianSuite -> Bool
isStable DebianSuite
suite =
		let l :: Url
l = Url
"deb http://security.debian.org/debian-security " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
securitysuite Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
" " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ [Url] -> Url
unwords [Url]
stdSections
		in [Url
l, ShowS
srcLine Url
l]
	| Bool
otherwise = []
  where
	securitysuite :: Url
securitysuite
		| DebianSuite
suite DebianSuite -> [DebianSuite] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Url -> DebianSuite) -> [Url] -> [DebianSuite]
forall a b. (a -> b) -> [a] -> [b]
map Url -> DebianSuite
Stable [Url]
releasesusingoldname =
			DebianSuite -> Url
showSuite DebianSuite
suite Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"/updates"
		| Bool
otherwise = DebianSuite -> Url
showSuite DebianSuite
suite Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"-security"
	releasesusingoldname :: [Url]
releasesusingoldname = [Url
"jessie", Url
"buster", Url
"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 = Url
-> (OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
    -> Maybe System -> Propellor Result)
-> Property Debian
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
"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 -> [SourcesGenerator] -> 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 -> [SourcesGenerator] -> Property Debian
stdSourcesList' DebianSuite
suite [SourcesGenerator]
more = Property DebianLike -> Property Debian
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
$
	Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror Url
desc ((Url -> Property DebianLike) -> Property DebianLike)
-> (Url -> Property DebianLike) -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \Url
u -> [Url] -> Property DebianLike
setSourcesList
		((SourcesGenerator -> [Url]) -> [SourcesGenerator] -> [Url]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\SourcesGenerator
gen -> SourcesGenerator
gen DebianSuite
suite) (Url -> [SourcesGenerator]
generators Url
u))
  where
	generators :: Url -> [SourcesGenerator]
generators Url
u = [Url -> SourcesGenerator
binandsrc Url
u, SourcesGenerator
securityUpdates] [SourcesGenerator] -> [SourcesGenerator] -> [SourcesGenerator]
forall a. [a] -> [a] -> [a]
++ [SourcesGenerator]
more
	desc :: Url
desc = (Url
"standard sources.list for " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
forall a. Show a => a -> Url
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 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 Debian -> Property Debian
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property Debian -> Property Debian)
-> Property Debian -> Property Debian
forall a b. (a -> b) -> a -> b
$ Url -> Props Debian -> Property Debian
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Url
desc Bool
True) (Props Debian -> Property Debian)
-> Props Debian -> Property Debian
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		Props UnixLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Url -> [Url] -> Property UnixLike
File.hasContent Url
prefFile (Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
"*" DebianSuite
s Int
pin)
		Props UnixLike
-> Property Debian
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian]))
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property Debian
setSourcesFile

	unavailable :: Property Debian
	unavailable :: Property Debian
unavailable = Property DebianLike -> Property Debian
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
$ Url -> Props DebianLike -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Bool -> Url
desc Bool
False) (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (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))
& Url -> Property UnixLike
File.notPresent Url
sourcesFile
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
		Props DebianLike
-> Property UnixLike
-> 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))
& Url -> Property UnixLike
File.notPresent Url
prefFile

	setSourcesFile :: Property Debian
	setSourcesFile :: Property Debian
setSourcesFile = Property DebianLike -> Property Debian
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
$ Url -> (Url -> Property DebianLike) -> Property DebianLike
withMirror (Bool -> Url
desc Bool
True) ((Url -> Property DebianLike) -> Property DebianLike)
-> (Url -> Property DebianLike) -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \Url
u ->
		Url
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (Bool -> Url
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
$
					Url -> [Url] -> Property UnixLike
File.hasContent Url
sourcesFile (Url -> [Url]
sources Url
u)
					Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
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 :: Url -> [Url]
sources Url
u = [Url] -> [Url]
dropBackports ([Url] -> [Url]) -> [Url] -> [Url]
forall a b. (a -> b) -> a -> b
$ (SourcesGenerator -> [Url]) -> [SourcesGenerator] -> [Url]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\SourcesGenerator
gen -> SourcesGenerator
gen DebianSuite
s) (Url -> [SourcesGenerator]
generators Url
u)
	  where
		dropBackports :: [Url] -> [Url]
dropBackports
			| Url
"-backports" Url -> Url -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (DebianSuite -> Url
showSuite DebianSuite
s) = [Url] -> [Url]
forall a. a -> a
id
			| Bool
otherwise = (Url -> Bool) -> [Url] -> [Url]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Url -> Bool) -> Url -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> Url -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf Url
"-backports")

	generators :: Url -> [SourcesGenerator]
generators Url
u = [Url -> SourcesGenerator
binandsrc Url
u, SourcesGenerator
securityUpdates]
	prefFile :: Url
prefFile = Url
"/etc/apt/preferences.d/20" Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
".pref"
	sourcesFile :: Url
sourcesFile = Url
"/etc/apt/sources.list.d/" Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
".list"

	desc :: Bool -> Url
desc Bool
True = Url
"Debian " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
" pinned, priority " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Url
forall a. Show a => a -> Url
show Int
pin
	desc Bool
False = Url
"Debian " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
" not pinned"

setSourcesList :: [Line] -> Property DebianLike
setSourcesList :: [Url] -> Property DebianLike
setSourcesList [Url]
ls = Url
sourcesList Url -> [Url] -> Property UnixLike
`File.hasContent` [Url]
ls Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update

setSourcesListD :: [Line] -> FilePath -> Property DebianLike
setSourcesListD :: [Url] -> Url -> Property DebianLike
setSourcesListD [Url]
ls Url
basename = Url
f Url -> [Url] -> Property UnixLike
`File.hasContent` [Url]
ls Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
update
  where
	f :: Url
f = Url
"/etc/apt/sources.list.d/" Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
basename Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
".list"

runApt :: [String] -> UncheckedProperty DebianLike
runApt :: [Url] -> UncheckedProperty DebianLike
runApt [Url]
ps = UncheckedProperty UnixLike -> UncheckedProperty DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (UncheckedProperty UnixLike -> UncheckedProperty DebianLike)
-> UncheckedProperty UnixLike -> UncheckedProperty DebianLike
forall a b. (a -> b) -> a -> b
$ Url -> [Url] -> [(Url, Url)] -> UncheckedProperty UnixLike
cmdPropertyEnv Url
"apt-get" [Url]
ps [(Url, Url)]
noninteractiveEnv

noninteractiveEnv :: [(String, String)]
noninteractiveEnv :: [(Url, Url)]
noninteractiveEnv =
		[ (Url
"DEBIAN_FRONTEND", Url
"noninteractive")
		, (Url
"APT_LISTCHANGES_FRONTEND", Url
"none")
		]

-- | Have apt update its lists of packages, but without upgrading anything.
update :: Property DebianLike
update :: Property DebianLike
update = Url -> Props DebianLike -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Url
desc (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (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 :: Url
desc = Url
"apt update"
	aptupdate :: Property DebianLike
	aptupdate :: Property DebianLike
aptupdate = Url
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
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
$
				-- rolling suites' release info can change
				[Url] -> UncheckedProperty DebianLike
runApt [Url
"update", Url
"--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
$ 
			[Url] -> UncheckedProperty DebianLike
runApt [Url
"update"]
				UncheckedProperty DebianLike -> Result -> Property DebianLike
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 = Url -> Property DebianLike
upgrade' Url
"dist-upgrade"

upgrade' :: String -> Property DebianLike
upgrade' :: Url -> Property DebianLike
upgrade' Url
p = Url -> Props DebianLike -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Url
"apt " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
p) (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (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))
& [Url] -> UncheckedProperty DebianLike
runApt [Url
"-y", Url
p]
		UncheckedProperty DebianLike -> Result -> Property DebianLike
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 = Url -> Property DebianLike
upgrade' Url
"upgrade"

-- | Have dpkg try to configure any packages that are not fully configured.
pendingConfigured :: Property DebianLike
pendingConfigured :: Property DebianLike
pendingConfigured = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	Url -> [Url] -> [(Url, Url)] -> UncheckedProperty UnixLike
cmdPropertyEnv Url
"dpkg" [Url
"--configure", Url
"--pending"] [(Url, Url)]
noninteractiveEnv
		UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		Property UnixLike -> Url -> Property UnixLike
forall p. IsProp p => p -> Url -> p
`describe` Url
"dpkg configured pending"

type Package = String

installed :: [Package] -> Property DebianLike
installed :: [Url] -> Property DebianLike
installed = [Url] -> [Url] -> Property DebianLike
installed' [Url
"-y"]

-- | Minimal install of package, without recommends.
installedMin :: [Package] -> Property DebianLike
installedMin :: [Url] -> Property DebianLike
installedMin = [Url] -> [Url] -> Property DebianLike
installed' [Url
"--no-install-recommends", Url
"-y"]

installed' :: [String] -> [Package] -> Property DebianLike
installed' :: [Url] -> [Url] -> Property DebianLike
installed' [Url]
params [Url]
ps = Property DebianLike -> Property DebianLike
robustly (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
<$> [Url] -> IO Bool
isInstalled' [Url]
ps) UncheckedProperty DebianLike
go
	Property DebianLike -> Url -> Property DebianLike
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords (Url
"apt installed"Url -> [Url] -> [Url]
forall a. a -> [a] -> [a]
:[Url]
ps)
  where
	go :: UncheckedProperty DebianLike
go = [Url] -> UncheckedProperty DebianLike
runApt ([Url]
params [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ [Url
"install"] [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ [Url]
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 :: [Url] -> Property Debian
backportInstalled = [Url] -> [Url] -> Property Debian
backportInstalled' [Url
"-y"]

-- | Minimal install from the stable-backports suite, without recommends.
backportInstalledMin :: [Package] -> Property Debian
backportInstalledMin :: [Url] -> Property Debian
backportInstalledMin = [Url] -> [Url] -> Property Debian
backportInstalled' [Url
"--no-install-recommends", Url
"-y"]

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

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

buildDep :: [Package] -> Property DebianLike
buildDep :: [Url] -> Property DebianLike
buildDep [Url]
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 -> Url -> Property DebianLike
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
	Property DebianLike -> Url -> Property DebianLike
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords (Url
"apt build-dep"Url -> [Url] -> [Url]
forall a. a -> [a] -> [a]
:[Url]
ps)
  where
	go :: UncheckedProperty DebianLike
go = [Url] -> UncheckedProperty DebianLike
runApt ([Url] -> UncheckedProperty DebianLike)
-> [Url] -> UncheckedProperty DebianLike
forall a b. (a -> b) -> a -> b
$ [Url
"-y", Url
"build-dep"] [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ [Url]
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 :: Url -> Property DebianLike
buildDepIn Url
dir = UncheckedProperty DebianLike
go
	UncheckedProperty DebianLike -> Url -> Property DebianLike
forall (p :: * -> *) i. Checkable p i => p i -> Url -> Property i
`changesFile` Url
dpkgStatus
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Url] -> Property DebianLike
installedMin [Url
"devscripts", Url
"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 = 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
$ Url -> Propellor Result -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property (Url
"build-dep in " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
dir) (Propellor Result -> Property DebianLike)
-> Propellor Result -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$
		Url -> (Url -> IO Result) -> IO Result
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Url -> (Url -> m a) -> m a
withTmpDir Url
"build-dep" ((Url -> IO Result) -> IO Result)
-> (Url -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Url
tmpdir -> do
			Bool -> Result
cmdResult (Bool -> Result) -> IO Bool -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Url
-> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
boolSystem' Url
"mk-build-deps"
				[ Url -> CommandParam
File (Url -> CommandParam) -> Url -> CommandParam
forall a b. (a -> b) -> a -> b
$ Url
dir Url -> ShowS
</> Url
"debian" Url -> ShowS
</> Url
"control"
				, Url -> CommandParam
Param Url
"--install"
				, Url -> CommandParam
Param Url
"--tool"
				, Url -> CommandParam
Param Url
"apt-get -y --no-install-recommends"
				] (\CreateProcess
p -> CreateProcess
p { cwd :: Maybe Url
cwd = Url -> Maybe Url
forall a. a -> Maybe a
Just Url
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 :: [Url] -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo [Url]
ps [(DebianSuite, Int)]
pins = [RevertableProperty Debian Debian]
-> RevertableProperty Debian Debian
forall a. Monoid a => [a] -> a
mconcat ((Url -> RevertableProperty Debian Debian)
-> [Url] -> [RevertableProperty Debian Debian]
forall a b. (a -> b) -> [a] -> [b]
map (\Url
p -> Url -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Url
p [(DebianSuite, Int)]
pins) [Url]
ps)
	RevertableProperty Debian Debian
-> Url -> RevertableProperty Debian Debian
forall p. IsProp p => p -> Url -> p
`describe` [Url] -> Url
unwords ((Url
"pinned to " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
showSuites)Url -> [Url] -> [Url]
forall a. a -> [a] -> [a]
:[Url]
ps)
  where
	showSuites :: Url
showSuites = Url -> [Url] -> Url
forall a. [a] -> [[a]] -> [a]
intercalate Url
"," ([Url] -> Url) -> [Url] -> Url
forall a b. (a -> b) -> a -> b
$ DebianSuite -> Url
showSuite (DebianSuite -> Url)
-> ((DebianSuite, Int) -> DebianSuite) -> (DebianSuite, Int) -> Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DebianSuite, Int) -> DebianSuite
forall a b. (a, b) -> a
fst ((DebianSuite, Int) -> Url) -> [(DebianSuite, Int)] -> [Url]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(DebianSuite, Int)]
pins

pinnedTo'
	:: AptPackagePref
	-> [(DebianSuite, PinPriority)]
	-> RevertableProperty Debian Debian
pinnedTo' :: Url -> [(DebianSuite, Int)] -> RevertableProperty Debian Debian
pinnedTo' Url
p [(DebianSuite, Int)]
pins =
	(Property UnixLike -> Property Debian
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property Debian)
-> Property UnixLike -> Property Debian
forall a b. (a -> b) -> a -> b
$ Url
prefFile Url -> [Url] -> Property UnixLike
`File.hasContent` [Url]
prefs)
	Property Debian
-> Property Debian -> RevertableProperty Debian Debian
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> (Property UnixLike -> Property Debian
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property Debian)
-> Property UnixLike -> Property Debian
forall a b. (a -> b) -> a -> b
$ Url -> Property UnixLike
File.notPresent Url
prefFile)
  where
	prefs :: [Url]
prefs = ((DebianSuite, Int) -> [Url] -> [Url])
-> [Url] -> [(DebianSuite, Int)] -> [Url]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DebianSuite, Int) -> [Url] -> [Url]
step [] [(DebianSuite, Int)]
pins
	step :: (DebianSuite, Int) -> [Url] -> [Url]
step (DebianSuite
suite, Int
pin) [Url]
ls = [Url]
ls [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
p DebianSuite
suite Int
pin [Url] -> [Url] -> [Url]
forall a. [a] -> [a] -> [a]
++ [Url
""]
	prefFile :: Url
prefFile = Url
"/etc/apt/preferences.d/10propellor_"
		Url -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
File.configFileName Url
p Url -> ShowS
<.> Url
"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 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 :: Url -> IO Bool
isInstalled Url
p = [Url] -> IO Bool
isInstalled' [Url
p]

isInstalled' :: [Package] -> IO Bool
isInstalled' :: [Url] -> IO Bool
isInstalled' [Url]
ps = do
	[InstallStatus]
is <- [Url] -> IO [InstallStatus]
getInstallStatus [Url]
ps
	Bool -> IO Bool
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 (t :: * -> *) a. Foldable t => t a -> Int
length [InstallStatus]
is Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Url] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Url]
ps

data InstallStatus = IsInstalled | NotInstalled
	deriving (Int -> InstallStatus -> ShowS
[InstallStatus] -> ShowS
InstallStatus -> Url
(Int -> InstallStatus -> ShowS)
-> (InstallStatus -> Url)
-> ([InstallStatus] -> ShowS)
-> Show InstallStatus
forall a.
(Int -> a -> ShowS) -> (a -> Url) -> ([a] -> ShowS) -> Show a
showList :: [InstallStatus] -> ShowS
$cshowList :: [InstallStatus] -> ShowS
show :: InstallStatus -> Url
$cshow :: InstallStatus -> Url
showsPrec :: Int -> InstallStatus -> ShowS
$cshowsPrec :: Int -> InstallStatus -> ShowS
Show, InstallStatus -> InstallStatus -> Bool
(InstallStatus -> InstallStatus -> Bool)
-> (InstallStatus -> InstallStatus -> Bool) -> Eq InstallStatus
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 :: [Url] -> IO [InstallStatus]
getInstallStatus [Url]
ps = (Url -> Maybe InstallStatus) -> [Url] -> [InstallStatus]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Url -> Maybe InstallStatus
parse ([Url] -> [InstallStatus])
-> (Url -> [Url]) -> Url -> [InstallStatus]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> [Url]
lines (Url -> [InstallStatus]) -> IO Url -> IO [InstallStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Url
policy
  where
	parse :: Url -> Maybe InstallStatus
parse Url
l
		| Url
"Installed: (none)" Url -> Url -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Url
l = InstallStatus -> Maybe InstallStatus
forall a. a -> Maybe a
Just InstallStatus
NotInstalled
		| Url
"Installed: " Url -> Url -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Url
l = InstallStatus -> Maybe InstallStatus
forall a. a -> Maybe a
Just InstallStatus
IsInstalled
		| Bool
otherwise = Maybe InstallStatus
forall a. Maybe a
Nothing
	policy :: IO Url
policy = do
		[(Url, Url)]
environ <- Url -> Url -> [(Url, Url)] -> [(Url, Url)]
forall k v. Eq k => k -> v -> [(k, v)] -> [(k, v)]
addEntry Url
"LANG" Url
"C" ([(Url, Url)] -> [(Url, Url)])
-> IO [(Url, Url)] -> IO [(Url, Url)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(Url, Url)]
getEnvironment
		Url -> [Url] -> Maybe [(Url, Url)] -> IO Url
readProcessEnv Url
"apt-cache" (Url
"policy"Url -> [Url] -> [Url]
forall a. a -> [a] -> [a]
:[Url]
ps) ([(Url, Url)] -> Maybe [(Url, Url)]
forall a. a -> Maybe a
Just [(Url, Url)]
environ)

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

-- | Enables unattended upgrades. Revert to disable.
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 (Property DebianLike) (Property UnixLike)
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` Url -> Property DebianLike
Service.running Url
"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
		-- work around http://bugs.debian.org/812380
		Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Url -> Property UnixLike
File.notPresent Url
"/etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist"
	disable :: Property DebianLike
disable = Bool -> Property DebianLike
setup Bool
False

	setup :: Bool -> Property DebianLike
setup Bool
enabled = (if Bool
enabled then [Url] -> Property DebianLike
installed else [Url] -> Property DebianLike
removed) [Url
"unattended-upgrades"]
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Url -> [(Url, Url, Url)] -> Property DebianLike
reConfigure Url
"unattended-upgrades"
			[(Url
"unattended-upgrades/enable_auto_updates" , Url
"boolean", Url
v)]
		Property DebianLike -> Url -> Property DebianLike
forall p. IsProp p => p -> Url -> p
`describe` (Url
"unattended upgrades " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
v)
	  where
		v :: Url
v
			| Bool
enabled = Url
"true"
			| Bool
otherwise = Url
"false"

	configure :: Property DebianLike
	configure :: Property DebianLike
configure = Url -> Props DebianLike -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Url
"unattended upgrades configured" (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (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 UnixLike
-> 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))
& Url
unattendedconfig Url -> Url -> Property UnixLike
`File.containsLine` Url
"Unattended-Upgrade::Mail \"root\";"
	  where
		enableupgrading :: Property DebianLike
		enableupgrading :: Property DebianLike
enableupgrading = Url
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Url
"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
				-- the package defaults to only upgrading stable
				(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_))
					| Bool -> Bool
not (DebianSuite -> Bool
isStable DebianSuite
suite) -> OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
						Url
unattendedconfig
							Url -> Url -> Property UnixLike
`File.containsLine`
						(Url
"Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="Url -> ShowS
forall a. [a] -> [a] -> [a]
++DebianSuite -> Url
showSuite DebianSuite
suiteUrl -> ShowS
forall a. [a] -> [a] -> [a]
++Url
"\"; };")
				Maybe System
_ -> Propellor Result
noChange
		unattendedconfig :: Url
unattendedconfig = Url
"/etc/apt/apt.conf.d/50unattended-upgrades"

-- | Enable periodic updates (but not upgrades), including download
-- of packages.
periodicUpdates :: Property DebianLike
periodicUpdates :: Property DebianLike
periodicUpdates = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Url
"/etc/apt/apt.conf.d/02periodic" Url -> [Url] -> Property UnixLike
`File.hasContent`
	[ Url
"APT::Periodic::Enable \"1\";"
	, Url
"APT::Periodic::Update-Package-Lists \"1\";"
	, Url
"APT::Periodic::Download-Upgradeable-Packages \"1\";"
	, Url
"APT::Periodic::Verbose \"1\";"
	]

type DebconfTemplate = String
type DebconfTemplateType = String
type DebconfTemplateValue = String

-- | Preseeds debconf values and reconfigures the package so it takes
-- effect.
reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
reConfigure :: Url -> [(Url, Url, Url)] -> Property DebianLike
reConfigure Url
package [(Url, Url, Url)]
vals = Property DebianLike -> Property DebianLike
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 UnixLike
reconfigure
		Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
setselections
		Property DebianLike -> Url -> Property DebianLike
forall p. IsProp p => p -> Url -> p
`describe` (Url
"reconfigure " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
package)
  where
	setselections :: Property DebianLike
	setselections :: Property DebianLike
setselections = Url -> Propellor Result -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property Url
"preseed" (Propellor Result -> Property DebianLike)
-> Propellor Result -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
		if [(Url, Url, Url)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Url, Url, Url)]
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 CreateProcessRunner
createProcessSuccess
					(Url -> [Url] -> CreateProcess
proc Url
"debconf-set-selections" []) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
						[(Url, Url, Url)] -> ((Url, Url, Url) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Url, Url, Url)]
vals (((Url, Url, Url) -> IO ()) -> IO ())
-> ((Url, Url, Url) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Url
tmpl, Url
tmpltype, Url
value) ->
							Handle -> Url -> IO ()
hPutStrLn Handle
h (Url -> IO ()) -> Url -> IO ()
forall a b. (a -> b) -> a -> b
$ [Url] -> Url
unwords [Url
package, Url
tmpl, Url
tmpltype, Url
value]
						Handle -> IO ()
hClose Handle
h
	reconfigure :: Property UnixLike
reconfigure = Url -> [Url] -> [(Url, Url)] -> UncheckedProperty UnixLike
cmdPropertyEnv Url
"dpkg-reconfigure" [Url
"-fnone", Url
package] [(Url, Url)]
noninteractiveEnv
		UncheckedProperty UnixLike -> Result -> Property UnixLike
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 :: Url -> Property DebianLike
serviceInstalledRunning Url
svc = Url -> Property DebianLike
Service.running Url
svc Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Url] -> Property DebianLike
installed [Url
svc]

data AptKey = AptKey
	{ AptKey -> Url
keyname :: String
	, AptKey -> Url
pubkey :: String
	}

trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
trustsKey AptKey
k = AptKey -> Property DebianLike
trustsKey' AptKey
k 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
<$> Url -> IO Bool
doesFileExist Url
f) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Url -> Propellor Result -> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
Url -> Propellor Result -> Property (MetaTypes metatypes)
property Url
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 CreateProcessRunner
createProcessSuccess
		(Url -> [Url] -> CreateProcess
proc Url
"apt-key" [Url
"--keyring", Url
f, Url
"add", Url
"-"]) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
			Handle -> Url -> IO ()
hPutStr Handle
h (AptKey -> Url
pubkey AptKey
k)
			Handle -> IO ()
hClose Handle
h
	Url -> IO ()
nukeFile (Url -> IO ()) -> Url -> IO ()
forall a b. (a -> b) -> a -> b
$ Url
f Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"~" -- gpg dropping
  where
	desc :: Url
desc = Url
"apt trusts key " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ AptKey -> Url
keyname AptKey
k
	f :: Url
f = AptKey -> Url
aptKeyFile AptKey
k

untrustKey :: AptKey -> Property DebianLike
untrustKey :: AptKey -> Property DebianLike
untrustKey = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> (AptKey -> Property UnixLike) -> AptKey -> Property DebianLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> Property UnixLike
File.notPresent (Url -> Property UnixLike)
-> (AptKey -> Url) -> AptKey -> Property UnixLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AptKey -> Url
aptKeyFile

aptKeyFile :: AptKey -> FilePath
aptKeyFile :: AptKey -> Url
aptKeyFile AptKey
k = Url
"/etc/apt/trusted.gpg.d" Url -> ShowS
</> AptKey -> Url
keyname AptKey
k Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
".gpg"

-- | Cleans apt's cache of downloaded packages to avoid using up disk
-- space.
cacheCleaned :: Property DebianLike
cacheCleaned :: Property DebianLike
cacheCleaned = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Url -> [Url] -> UncheckedProperty UnixLike
cmdProperty Url
"apt-get" [Url
"clean"]
	UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property UnixLike -> Url -> Property UnixLike
forall p. IsProp p => p -> Url -> p
`describe` Url
"apt cache cleaned"

-- | Add a foreign architecture to dpkg and apt.
hasForeignArch :: String -> Property DebianLike
hasForeignArch :: Url -> Property DebianLike
hasForeignArch Url
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 UnixLike
add Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
update)
	Property DebianLike -> Url -> Property DebianLike
forall p. IsProp p => p -> Url -> p
`describe` (Url
"dpkg has foreign architecture " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
arch)
  where
	notAdded :: IO Bool
notAdded = (Url -> [Url] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Url
arch ([Url] -> Bool) -> (Url -> [Url]) -> Url -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> [Url]
lines) (Url -> Bool) -> IO Url -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Url -> [Url] -> IO Url
readProcess Url
"dpkg" [Url
"--print-foreign-architectures"]
	add :: Property UnixLike
add = Url -> [Url] -> UncheckedProperty UnixLike
cmdProperty Url
"dpkg" [Url
"--add-architecture", Url
arch]
		UncheckedProperty UnixLike -> Result -> Property UnixLike
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 = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Url
"/etc/apt/apt.conf.d/20pdiffs" Url -> [Url] -> Property UnixLike
`File.hasContent`
	[ Url
"Acquire::PDiffs \"false\";" ]

suitePin :: DebianSuite -> String
suitePin :: DebianSuite -> Url
suitePin DebianSuite
s = DebianSuite -> Url
prefix DebianSuite
s Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
showSuite DebianSuite
s
  where
	prefix :: DebianSuite -> Url
prefix (Stable Url
_) = Url
"n="
	prefix DebianSuite
_ = Url
"a="

suitePinBlock :: AptPackagePref -> DebianSuite -> PinPriority -> [Line]
suitePinBlock :: Url -> DebianSuite -> Int -> [Url]
suitePinBlock Url
p DebianSuite
suite Int
pin =
	[ Url
"Explanation: This file added by propellor"
	, Url
"Package: " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
p
	, Url
"Pin: release " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ DebianSuite -> Url
suitePin DebianSuite
suite
	, Url
"Pin-Priority: " Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Url
forall t. ConfigurableValue t => t -> Url
val Int
pin
	]

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

-- | Set apt's proxy
proxy :: Url -> Property (HasInfo + DebianLike)
proxy :: Url -> Property (HasInfo + DebianLike)
proxy Url
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 (Url -> Property DebianLike
proxy' Url
u) (Url -> Info
proxyInfo Url
u)
  where
	proxyInfo :: Url -> Info
proxyInfo = InfoVal HostAptProxy -> Info
forall v. IsInfo v => v -> Info
toInfo (InfoVal HostAptProxy -> Info)
-> (Url -> InfoVal HostAptProxy) -> Url -> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAptProxy -> InfoVal HostAptProxy
forall v. v -> InfoVal v
InfoVal (HostAptProxy -> InfoVal HostAptProxy)
-> (Url -> HostAptProxy) -> Url -> InfoVal HostAptProxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> HostAptProxy
HostAptProxy

proxy' :: Url -> Property DebianLike
proxy' :: Url -> Property DebianLike
proxy' Url
u = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	Url
"/etc/apt/apt.conf.d/20proxy" Url -> [Url] -> Property UnixLike
`File.hasContent`
		[ Url
"Acquire::HTTP::Proxy \"" Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
u Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
"\";" ]
		Property UnixLike -> Url -> Property UnixLike
forall p. IsProp p => p -> Url -> p
`describe` Url
desc
  where
	desc :: Url
desc = (Url
u Url -> ShowS
forall a. [a] -> [a] -> [a]
++ Url
" apt proxy selected")

-- | Cause apt to proxy downloads via an apt cacher on localhost
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher :: Property (HasInfo + DebianLike)
useLocalCacher = Url -> Property (HasInfo + DebianLike)
proxy Url
"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` Url -> Property DebianLike
serviceInstalledRunning Url
"apt-cacher-ng"
	Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Url
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall p. IsProp p => p -> Url -> p
`describe` Url
"apt uses local apt cacher"