module Propellor.Property.ConfFile (
	-- * Generic conffiles with sections
	SectionStart,
	SectionPast,
	AdjustSection,
	InsertSection,
	adjustSection,
	-- * Windows .ini files
	IniSection,
	IniKey,
	containsIniSetting,
	lacksIniSetting,
	hasIniSection,
	lacksIniSection,
	iniFileContains,
	-- * Conffiles that are actually shell scripts setting env vars
	ShellKey,
	containsShellSetting,
	lacksShellSetting,
) where

import Propellor.Base
import Propellor.Property.File

import Data.List (isPrefixOf, foldl')

-- | find the line that is the start of the wanted section (eg, == "<Foo>")
type SectionStart  = Line -> Bool
-- | find a line that indicates we are past the section
-- (eg, a new section header)
type SectionPast   = Line -> Bool
-- | run on all lines in the section, including the SectionStart line;
-- can add, delete, and modify lines, or even delete entire section
type AdjustSection = [Line] -> [Line]
-- | if SectionStart does not find the section in the file, this is used to
-- insert the section somewhere within it
type InsertSection = [Line] -> [Line]

-- | Adjusts a section of conffile.
adjustSection
	:: Desc
	-> SectionStart
	-> SectionPast
	-> AdjustSection
	-> InsertSection
	-> FilePath
	-> Property UnixLike
adjustSection :: Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection Desc
desc SectionStart
start SectionStart
past AdjustSection
adjust AdjustSection
insert = Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty Desc
desc AdjustSection
go
  where
	go :: AdjustSection
go [Desc]
ls = let ([Desc]
pre, [Desc]
wanted, [Desc]
post) = (([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc]))
-> ([Desc], [Desc], [Desc]) -> [Desc] -> ([Desc], [Desc], [Desc])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([], [], []) [Desc]
ls
		in if [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted
			then AdjustSection
insert [Desc]
ls
			else [Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ AdjustSection
adjust [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc]
post
	find :: ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([Desc]
pre, [Desc]
wanted, [Desc]
post) Desc
l
		| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
start) Desc
l =
			([Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
wanted, [Desc]
post)
		| (SectionStart
start Desc
l Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post)
		  Bool -> Bool -> Bool
|| ((Bool -> Bool
not (Bool -> Bool) -> ([Desc] -> Bool) -> [Desc] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
past) Desc
l) =
			  ([Desc]
pre, [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
post)
		| Bool
otherwise = ([Desc]
pre, [Desc]
wanted, [Desc]
post [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l])

-- | Name of a section of an .ini file. This value is put
-- in square braces to generate the section header.
type IniSection = String

-- | Name of a configuration setting within a .ini file.
type IniKey = String

iniHeader :: IniSection -> String
iniHeader :: Desc -> Desc
iniHeader Desc
header = Char
'[' Char -> Desc -> Desc
forall a. a -> [a] -> [a]
: Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"]"

adjustIniSection
	:: Desc
	-> IniSection
	-> AdjustSection
	-> InsertSection
	-> FilePath
	-> Property UnixLike
adjustIniSection :: Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection Desc
desc Desc
header =
	Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection
	Desc
desc
	(Desc -> SectionStart
forall a. Eq a => a -> a -> Bool
== Desc -> Desc
iniHeader Desc
header)
	(Desc
"[" Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

-- | Ensures that a .ini file exists and contains a section
-- with a key=value setting.
containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
containsIniSetting :: Desc -> (Desc, Desc, Desc) -> Property UnixLike
containsIniSetting Desc
f (Desc
header, Desc
key, Desc
value) = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
	(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"] contains " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value)
	Desc
header
	AdjustSection
go
	([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
confheader, Desc
confline]) -- add missing section at end
	Desc
f
  where
	confheader :: Desc
confheader = Desc -> Desc
iniHeader Desc
header
	confline :: Desc
confline   = Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value
	go :: AdjustSection
go []      = [Desc
confline]
	go (Desc
l:[Desc]
ls)  = if SectionStart
isKeyVal Desc
l then Desc
confline Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
ls else Desc
l Desc -> AdjustSection
forall a. a -> [a] -> [a]
: AdjustSection
go [Desc]
ls
	isKeyVal :: SectionStart
isKeyVal Desc
x = ((Char -> Bool) -> Desc -> Desc
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (Desc -> Desc) -> (Desc -> Desc) -> Desc -> Desc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Desc -> Desc
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')) Desc
x Desc -> [Desc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Desc
key, Char
'#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
key]

-- | Removes a key=value setting from a section of an .ini file.
-- Note that the section heading is left in the file, so this is not a
-- perfect reversion of containsIniSetting.
lacksIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
lacksIniSetting :: Desc -> (Desc, Desc, Desc) -> Property UnixLike
lacksIniSetting Desc
f (Desc
header, Desc
key, Desc
value) = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
	(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"] lacks " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value)
	Desc
header
	(SectionStart -> AdjustSection
forall a. (a -> Bool) -> [a] -> [a]
filter (Desc -> SectionStart
forall a. Eq a => a -> a -> Bool
/= Desc
confline))
	AdjustSection
forall a. a -> a
id
	Desc
f
  where
	confline :: Desc
confline = Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value

-- | Ensures that a .ini file exists and contains a section
-- with a given key=value list of settings.
hasIniSection :: FilePath -> IniSection -> [(IniKey, String)] -> Property UnixLike
hasIniSection :: Desc -> Desc -> [(Desc, Desc)] -> Property UnixLike
hasIniSection Desc
f Desc
header [(Desc, Desc)]
keyvalues = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
	(Desc
"set " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"]")
	Desc
header
	AdjustSection
forall p. p -> [Desc]
go
	([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ Desc
confheader Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
conflines) -- add missing section at end
	Desc
f
  where
	confheader :: Desc
confheader = Desc -> Desc
iniHeader Desc
header
	conflines :: [Desc]
conflines  = ((Desc, Desc) -> Desc) -> [(Desc, Desc)] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Desc
key, Desc
value) -> Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value) [(Desc, Desc)]
keyvalues
	go :: p -> [Desc]
go p
_       = Desc
confheader Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
conflines

-- | Ensures that a .ini file does not contain the specified section.
lacksIniSection :: FilePath -> IniSection -> Property UnixLike
lacksIniSection :: Desc -> Desc -> Property UnixLike
lacksIniSection Desc
f Desc
header = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
	(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" lacks section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"]")
	Desc
header
	([Desc] -> AdjustSection
forall a b. a -> b -> a
const []) -- remove all lines of section
	AdjustSection
forall a. a -> a
id -- add no lines if section is missing
	Desc
f

-- | Specifies the whole content of a .ini file.
--
-- Revertijg this causes the file not to exist.
iniFileContains :: FilePath -> [(IniSection, [(IniKey, String)])] -> RevertableProperty UnixLike UnixLike
iniFileContains :: Desc
-> [(Desc, [(Desc, Desc)])] -> RevertableProperty UnixLike UnixLike
iniFileContains Desc
f [(Desc, [(Desc, Desc)])]
l = Desc
f Desc -> [Desc] -> Property UnixLike
`hasContent` [Desc]
content Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Desc -> Property UnixLike
notPresent Desc
f
  where
	content :: [Desc]
content = ((Desc, [(Desc, Desc)]) -> [Desc])
-> [(Desc, [(Desc, Desc)])] -> [Desc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Desc, [(Desc, Desc)]) -> [Desc]
sectioncontent [(Desc, [(Desc, Desc)])]
l
	sectioncontent :: (Desc, [(Desc, Desc)]) -> [Desc]
sectioncontent (Desc
section, [(Desc, Desc)]
keyvalues) = Desc -> Desc
iniHeader Desc
section Desc -> AdjustSection
forall a. a -> [a] -> [a]
:
		((Desc, Desc) -> Desc) -> [(Desc, Desc)] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Desc
key, Desc
value) -> Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value) [(Desc, Desc)]
keyvalues

-- | Key for a shell conffile property.  Conventionally uppercase letters and
-- numbers with underscores for separators.  See files in </etc/default>.
type ShellKey = String

-- | Ensures a shell conffile (like those in </etc/default>) exists and has a
-- key=value pair.
--
-- Comments out any further settings of that key further down the
-- file, to avoid those taking precedence.
containsShellSetting :: FilePath -> (ShellKey, String) -> Property UnixLike
containsShellSetting :: Desc -> (Desc, Desc) -> Property UnixLike
containsShellSetting Desc
f (Desc
k, Desc
v) = Property UnixLike
adjust Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
dedup
  where
	adjust :: Property UnixLike
adjust = Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection
		(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" contains " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
v)
		SectionStart
isline
		(Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline)
		([Desc] -> AdjustSection
forall a b. a -> b -> a
const [Desc
line])
		([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
line])
		Desc
f
	dedup :: Property UnixLike
dedup = Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty Desc
"" AdjustSection
forall (t :: * -> *). Foldable t => t Desc -> [Desc]
dedup' Desc
f
	dedup' :: t Desc -> [Desc]
dedup' t Desc
ls = let ([Desc]
pre, [Desc]
wanted, [Desc]
post) = (([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc]))
-> ([Desc], [Desc], [Desc]) -> t Desc -> ([Desc], [Desc], [Desc])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([], [], []) t Desc
ls
		    in [Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ (Desc -> Desc) -> AdjustSection
forall a b. (a -> b) -> [a] -> [b]
map Desc -> Desc
commentIfIsline [Desc]
post
	find :: ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([Desc]
pre, [Desc]
wanted, [Desc]
post) Desc
l
		| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline) Desc
l = ([Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
wanted, [Desc]
post)
		| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& SectionStart
isline Desc
l         = ([Desc]
pre, [Desc
l], [Desc]
post)
		| Bool
otherwise                       = ([Desc]
pre, [Desc]
wanted, [Desc]
post [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l])
	-- some /etc/default files comment settings lines with '# '
	-- and some use '#'; one advantage of just using '#' is that
	-- it distinguishes settings values from prose comments
	commentIfIsline :: Desc -> Desc
commentIfIsline Desc
l
		| SectionStart
isline Desc
l  = Char
'#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
l
		| Bool
otherwise = Desc
l

	isline :: SectionStart
isline Desc
s = (Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=") Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
s
	line :: Desc
line = Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape Desc
v

-- | Comments out a key=value pair in a shell conffile.
--
-- Does not delete the file if empty, and does not uncomment any
-- lines, so not a perfect reversion of 'containsShellSetting'.
lacksShellSetting :: FilePath -> (ShellKey, String) -> Property UnixLike
lacksShellSetting :: Desc -> (Desc, Desc) -> Property UnixLike
lacksShellSetting Desc
f (Desc
k, Desc
v) =
	Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty (Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"lacks shell setting " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
v) AdjustSection
go Desc
f
  where
	go :: AdjustSection
go [Desc]
ls = (Desc -> Desc) -> AdjustSection
forall a b. (a -> b) -> [a] -> [b]
map Desc -> Desc
commentOut [Desc]
ls
	commentOut :: Desc -> Desc
commentOut Desc
l
		| (Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"=") Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
l = Char
'#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
l
		| Bool
otherwise                 = Desc
l