-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
--
-- Personal Package Archives
module Propellor.Property.Apt.PPA where

import Data.List
import Control.Applicative
import Prelude
import Data.String (IsString(..))

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Utility.Split

-- | Ensure software-properties-common is installed.
installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"software-properties-common"]

-- | Personal Package Archives are people's individual package
-- contributions to the Buntish distro. There's a well-known format for
-- representing them, and this type represents that. It's also an instance
-- of 'Show' and 'IsString' so it can work with 'OverloadedStrings'. 
-- More on PPAs can be found at <https://help.launchpad.net/Packaging/PPA>
data PPA = PPA
	{ PPA -> Package
ppaAccount :: String -- ^ The Launchpad account hosting this archive.
	, PPA -> Package
ppaArchive :: String -- ^ The name of the archive.
	} deriving (PPA -> PPA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPA -> PPA -> Bool
$c/= :: PPA -> PPA -> Bool
== :: PPA -> PPA -> Bool
$c== :: PPA -> PPA -> Bool
Eq, Eq PPA
PPA -> PPA -> Bool
PPA -> PPA -> Ordering
PPA -> PPA -> PPA
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PPA -> PPA -> PPA
$cmin :: PPA -> PPA -> PPA
max :: PPA -> PPA -> PPA
$cmax :: PPA -> PPA -> PPA
>= :: PPA -> PPA -> Bool
$c>= :: PPA -> PPA -> Bool
> :: PPA -> PPA -> Bool
$c> :: PPA -> PPA -> Bool
<= :: PPA -> PPA -> Bool
$c<= :: PPA -> PPA -> Bool
< :: PPA -> PPA -> Bool
$c< :: PPA -> PPA -> Bool
compare :: PPA -> PPA -> Ordering
$ccompare :: PPA -> PPA -> Ordering
Ord)

instance ConfigurableValue PPA where
	val :: PPA -> Package
val PPA
p = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Package
"ppa:", PPA -> Package
ppaAccount PPA
p, Package
"/", PPA -> Package
ppaArchive PPA
p]

instance IsString PPA where
	-- | Parse strings like "ppa:zfs-native/stable" into a PPA.
	fromString :: Package -> PPA
fromString Package
s = case forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"ppa:" Package
s of
		[Package
_, Package
ppa] -> case forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"/" Package
ppa of
			[Package
acct, Package
arch] -> Package -> Package -> PPA
PPA Package
acct Package
arch
			[Package]
_ -> Package -> Package -> PPA
PPA Package
s Package
s
		[Package]
_ -> Package -> Package -> PPA
PPA Package
s Package
s

-- | Adds a PPA to the local system repositories.
addPpa :: PPA -> Property DebianLike
addPpa :: PPA -> Property DebianLike
addPpa PPA
p =
	Package
-> [Package] -> [(Package, Package)] -> UncheckedProperty UnixLike
cmdPropertyEnv Package
"apt-add-repository" [Package
"--yes", forall t. ConfigurableValue t => t -> Package
val PPA
p] [(Package, Package)]
Apt.noninteractiveEnv
	forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	forall p. IsProp p => p -> Package -> p
`describe` (Package
"Added PPA " forall a. [a] -> [a] -> [a]
++ (forall t. ConfigurableValue t => t -> Package
val PPA
p))
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed

-- | A repository key ID to be downloaded with apt-key.
data AptKeyId = AptKeyId
	{ AptKeyId -> Package
akiName :: String
	, AptKeyId -> Package
akiId :: String
	, AptKeyId -> Package
akiServer :: String
	} deriving (AptKeyId -> AptKeyId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AptKeyId -> AptKeyId -> Bool
$c/= :: AptKeyId -> AptKeyId -> Bool
== :: AptKeyId -> AptKeyId -> Bool
$c== :: AptKeyId -> AptKeyId -> Bool
Eq, Eq AptKeyId
AptKeyId -> AptKeyId -> Bool
AptKeyId -> AptKeyId -> Ordering
AptKeyId -> AptKeyId -> AptKeyId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AptKeyId -> AptKeyId -> AptKeyId
$cmin :: AptKeyId -> AptKeyId -> AptKeyId
max :: AptKeyId -> AptKeyId -> AptKeyId
$cmax :: AptKeyId -> AptKeyId -> AptKeyId
>= :: AptKeyId -> AptKeyId -> Bool
$c>= :: AptKeyId -> AptKeyId -> Bool
> :: AptKeyId -> AptKeyId -> Bool
$c> :: AptKeyId -> AptKeyId -> Bool
<= :: AptKeyId -> AptKeyId -> Bool
$c<= :: AptKeyId -> AptKeyId -> Bool
< :: AptKeyId -> AptKeyId -> Bool
$c< :: AptKeyId -> AptKeyId -> Bool
compare :: AptKeyId -> AptKeyId -> Ordering
$ccompare :: AptKeyId -> AptKeyId -> Ordering
Ord)

-- | Adds an 'AptKeyId' from the specified GPG server.
addKeyId :: AptKeyId -> Property DebianLike
addKeyId :: AptKeyId -> Property DebianLike
addKeyId AptKeyId
keyId =
	forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
keyTrusted UncheckedProperty DebianLike
akcmd
	forall p. IsProp p => p -> Package -> p
`describe` ([Package] -> Package
unwords [Package
"Add third-party Apt key", AptKeyId -> Package
desc AptKeyId
keyId])
  where
	akcmd :: UncheckedProperty DebianLike
akcmd =
		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
$ Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"apt-key" [Package
"adv", Package
"--keyserver", AptKeyId -> Package
akiServer AptKeyId
keyId, Package
"--recv-keys", AptKeyId -> Package
akiId AptKeyId
keyId]
	keyTrusted :: IO Bool
keyTrusted =
		let
			pks :: Package -> [Package]
pks Package
ls = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"/")
				forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
words)
				forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Package
l -> Package
"pub" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Package
l)
					forall a b. (a -> b) -> a -> b
$ Package -> [Package]
lines Package
ls
			nkid :: Package
nkid = forall a. Int -> [a] -> [a]
take Int
8 (AptKeyId -> Package
akiId AptKeyId
keyId)
		in
			(forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Package
nkid] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
pks) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> IO Package
readProcess Package
"apt-key" [Package
"list"]
	desc :: AptKeyId -> Package
desc AptKeyId
k = [Package] -> Package
unwords [Package
"Apt Key", AptKeyId -> Package
akiName AptKeyId
k, AptKeyId -> Package
akiId AptKeyId
k, Package
"from", AptKeyId -> Package
akiServer AptKeyId
k]

-- | An Apt source line that apt-add-repository will just add to
-- sources.list. It's also an instance of both 'ConfigurableValue'
-- and 'IsString' to make using 'OverloadedStrings' in the configuration
-- file easier.
--
-- | FIXME there's apparently an optional "options" fragment that I've
-- definitely not parsed here.
data AptSource = AptSource
	{ AptSource -> Package
asURL :: Apt.Url -- ^ The URL hosting the repository
	, AptSource -> Package
asSuite :: String  -- ^ The operating system suite
	, AptSource -> [Package]
asComponents :: [String] -- ^ The list of components to install from this repository.
	} deriving (AptSource -> AptSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AptSource -> AptSource -> Bool
$c/= :: AptSource -> AptSource -> Bool
== :: AptSource -> AptSource -> Bool
$c== :: AptSource -> AptSource -> Bool
Eq, Eq AptSource
AptSource -> AptSource -> Bool
AptSource -> AptSource -> Ordering
AptSource -> AptSource -> AptSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AptSource -> AptSource -> AptSource
$cmin :: AptSource -> AptSource -> AptSource
max :: AptSource -> AptSource -> AptSource
$cmax :: AptSource -> AptSource -> AptSource
>= :: AptSource -> AptSource -> Bool
$c>= :: AptSource -> AptSource -> Bool
> :: AptSource -> AptSource -> Bool
$c> :: AptSource -> AptSource -> Bool
<= :: AptSource -> AptSource -> Bool
$c<= :: AptSource -> AptSource -> Bool
< :: AptSource -> AptSource -> Bool
$c< :: AptSource -> AptSource -> Bool
compare :: AptSource -> AptSource -> Ordering
$ccompare :: AptSource -> AptSource -> Ordering
Ord)

instance ConfigurableValue AptSource where
	val :: AptSource -> Package
val AptSource
asrc = [Package] -> Package
unwords [Package
"deb", AptSource -> Package
asURL AptSource
asrc, AptSource -> Package
asSuite AptSource
asrc, [Package] -> Package
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. AptSource -> [Package]
asComponents forall a b. (a -> b) -> a -> b
$ AptSource
asrc]

instance IsString AptSource where
	fromString :: Package -> AptSource
fromString Package
s = case forall a. Int -> [a] -> [a]
drop Int
1 (Package -> [Package]
words Package
s) of
		Package
url:Package
suite:[Package]
comps -> Package -> Package -> [Package] -> AptSource
AptSource Package
url Package
suite [Package]
comps
		[Package]
_ -> Package -> Package -> [Package] -> AptSource
AptSource Package
s Package
s []

-- | A repository for apt-add-source, either a PPA or a regular repository line.
data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource

-- | Adds an 'AptRepository' using apt-add-source.
addRepository :: AptRepository -> Property DebianLike
addRepository :: AptRepository -> Property DebianLike
addRepository (AptRepositoryPPA PPA
p) = PPA -> Property DebianLike
addPpa PPA
p
addRepository (AptRepositorySource AptSource
src) =
	forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
repoExists UncheckedProperty UnixLike
addSrc
	forall p. IsProp p => p -> Package -> p
`describe` [Package] -> Package
unwords [Package
"Adding APT repository", forall t. ConfigurableValue t => t -> Package
val AptSource
src]
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	allSourceLines :: IO Package
allSourceLines =
		Package -> [Package] -> IO Package
readProcess Package
"/bin/sh" [Package
"-c", Package
"cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
	activeSources :: IO [AptSource]
activeSources = forall a b. (a -> b) -> [a] -> [b]
map (\Package
s -> forall a. IsString a => Package -> a
fromString Package
s :: AptSource )
		forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
isPrefixOf Package
"#")
		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Package
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Package
allSourceLines
	repoExists :: IO Bool
repoExists = forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [AptSource
src] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [AptSource]
activeSources
	addSrc :: UncheckedProperty UnixLike
addSrc = Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"apt-add-source" [forall t. ConfigurableValue t => t -> Package
val AptSource
src]