-- | 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
(PPA -> PPA -> Bool) -> (PPA -> PPA -> Bool) -> Eq PPA
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
Eq PPA
-> (PPA -> PPA -> Ordering)
-> (PPA -> PPA -> Bool)
-> (PPA -> PPA -> Bool)
-> (PPA -> PPA -> Bool)
-> (PPA -> PPA -> Bool)
-> (PPA -> PPA -> PPA)
-> (PPA -> PPA -> PPA)
-> Ord 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
$cp1Ord :: Eq PPA
Ord)

instance ConfigurableValue PPA where
	val :: PPA -> Package
val PPA
p = [Package] -> Package
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 =
		let
			[Package
_, Package
ppa] = Package -> Package -> [Package]
forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"ppa:" Package
s
			[Package
acct, Package
arch] = Package -> Package -> [Package]
forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"/" Package
ppa
		in
			Package -> Package -> PPA
PPA Package
acct Package
arch

-- | 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", PPA -> Package
forall t. ConfigurableValue t => t -> Package
val PPA
p] [(Package, Package)]
Apt.noninteractiveEnv
	UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` (Package
"Added PPA " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ (PPA -> Package
forall t. ConfigurableValue t => t -> Package
val PPA
p))
	Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
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
(AptKeyId -> AptKeyId -> Bool)
-> (AptKeyId -> AptKeyId -> Bool) -> Eq AptKeyId
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
Eq AptKeyId
-> (AptKeyId -> AptKeyId -> Ordering)
-> (AptKeyId -> AptKeyId -> Bool)
-> (AptKeyId -> AptKeyId -> Bool)
-> (AptKeyId -> AptKeyId -> Bool)
-> (AptKeyId -> AptKeyId -> Bool)
-> (AptKeyId -> AptKeyId -> AptKeyId)
-> (AptKeyId -> AptKeyId -> AptKeyId)
-> Ord 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
$cp1Ord :: Eq AptKeyId
Ord)

-- | Adds an 'AptKeyId' from the specified GPG server.
addKeyId :: AptKeyId -> Property DebianLike
addKeyId :: AptKeyId -> Property DebianLike
addKeyId AptKeyId
keyId =
	IO Bool -> UncheckedProperty DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
keyTrusted UncheckedProperty DebianLike
akcmd
	Property DebianLike -> Package -> Property DebianLike
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 =
		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
$ 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 = (Package -> [Package]) -> [Package] -> [Package]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Package] -> [Package]
forall a. Int -> [a] -> [a]
drop Int
1 ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Package -> [Package]
forall a. Eq a => [a] -> [a] -> [[a]]
split Package
"/")
				([Package] -> [Package]) -> [Package] -> [Package]
forall a b. (a -> b) -> a -> b
$ (Package -> [Package]) -> [Package] -> [Package]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Package] -> [Package]
forall a. Int -> [a] -> [a]
take Int
1 ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Package] -> [Package]
forall a. Int -> [a] -> [a]
drop Int
1 ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
words)
				([Package] -> [Package]) -> [Package] -> [Package]
forall a b. (a -> b) -> a -> b
$ (Package -> Bool) -> [Package] -> [Package]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Package
l -> Package
"pub" Package -> Package -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Package
l)
					([Package] -> [Package]) -> [Package] -> [Package]
forall a b. (a -> b) -> a -> b
$ Package -> [Package]
lines Package
ls
			nkid :: Package
nkid = Int -> Package -> Package
forall a. Int -> [a] -> [a]
take Int
8 (AptKeyId -> Package
akiId AptKeyId
keyId)
		in
			([Package] -> [Package] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Package
nkid] ([Package] -> Bool) -> (Package -> [Package]) -> Package -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
pks) (Package -> Bool) -> IO Package -> IO Bool
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
(AptSource -> AptSource -> Bool)
-> (AptSource -> AptSource -> Bool) -> Eq AptSource
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
Eq AptSource
-> (AptSource -> AptSource -> Ordering)
-> (AptSource -> AptSource -> Bool)
-> (AptSource -> AptSource -> Bool)
-> (AptSource -> AptSource -> Bool)
-> (AptSource -> AptSource -> Bool)
-> (AptSource -> AptSource -> AptSource)
-> (AptSource -> AptSource -> AptSource)
-> Ord 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
$cp1Ord :: Eq AptSource
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 ([Package] -> Package)
-> (AptSource -> [Package]) -> AptSource -> Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AptSource -> [Package]
asComponents (AptSource -> Package) -> AptSource -> Package
forall a b. (a -> b) -> a -> b
$ AptSource
asrc]

instance IsString AptSource where
	fromString :: Package -> AptSource
fromString Package
s =
		let
			Package
url:Package
suite:[Package]
comps = Int -> [Package] -> [Package]
forall a. Int -> [a] -> [a]
drop Int
1 ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
words (Package -> [Package]) -> Package -> [Package]
forall a b. (a -> b) -> a -> b
$ Package
s
		in
			Package -> Package -> [Package] -> AptSource
AptSource Package
url Package
suite [Package]
comps

-- | 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) =
	IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
repoExists UncheckedProperty UnixLike
addSrc
	Property UnixLike -> Package -> Property UnixLike
forall p. IsProp p => p -> Package -> p
`describe` [Package] -> Package
unwords [Package
"Adding APT repository", AptSource -> Package
forall t. ConfigurableValue t => t -> Package
val AptSource
src]
	Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
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 = (Package -> AptSource) -> [Package] -> [AptSource]
forall a b. (a -> b) -> [a] -> [b]
map (\Package
s -> Package -> AptSource
forall a. IsString a => Package -> a
fromString Package
s :: AptSource )
		([Package] -> [AptSource])
-> (Package -> [Package]) -> Package -> [AptSource]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package -> Bool) -> [Package] -> [Package]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Package -> Bool) -> Package -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Package -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Package
"#")
		([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package -> Bool) -> [Package] -> [Package]
forall a. (a -> Bool) -> [a] -> [a]
filter (Package -> Package -> Bool
forall a. Eq a => a -> a -> Bool
/= Package
"") ([Package] -> [Package])
-> (Package -> [Package]) -> Package -> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> [Package]
lines (Package -> [AptSource]) -> IO Package -> IO [AptSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Package
allSourceLines
	repoExists :: IO Bool
repoExists = [AptSource] -> [AptSource] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [AptSource
src] ([AptSource] -> Bool) -> IO [AptSource] -> IO Bool
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" [AptSource -> Package
forall t. ConfigurableValue t => t -> Package
val AptSource
src]