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 :: [Char]
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustSection [Char]
desc SectionStart
start SectionStart
past AdjustSection
adjust AdjustSection
insert = forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty [Char]
desc AdjustSection
go
  where
	go :: AdjustSection
go [[Char]]
ls = let ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([[Char]], [[Char]], [[Char]])
-> [Char] -> ([[Char]], [[Char]], [[Char]])
find ([], [], []) [[Char]]
ls
		in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
wanted
			then AdjustSection
insert [[Char]]
ls
			else [[Char]]
pre forall a. [a] -> [a] -> [a]
++ AdjustSection
adjust [[Char]]
wanted forall a. [a] -> [a] -> [a]
++ [[Char]]
post
	find :: ([[Char]], [[Char]], [[Char]])
-> [Char] -> ([[Char]], [[Char]], [[Char]])
find ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post) [Char]
l
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
wanted Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
start) [Char]
l =
			([[Char]]
pre forall a. [a] -> [a] -> [a]
++ [[Char]
l], [[Char]]
wanted, [[Char]]
post)
		| (SectionStart
start [Char]
l Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
wanted Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
post)
		  Bool -> Bool -> Bool
|| ((Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]]
wanted Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
past) [Char]
l) =
			  ([[Char]]
pre, [[Char]]
wanted forall a. [a] -> [a] -> [a]
++ [[Char]
l], [[Char]]
post)
		| Bool
otherwise = ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post forall a. [a] -> [a] -> [a]
++ [[Char]
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 :: [Char] -> [Char]
iniHeader [Char]
header = Char
'[' forall a. a -> [a] -> [a]
: [Char]
header forall a. [a] -> [a] -> [a]
++ [Char]
"]"

adjustIniSection
	:: Desc
	-> IniSection
	-> AdjustSection
	-> InsertSection
	-> FilePath
	-> Property UnixLike
adjustIniSection :: [Char]
-> [Char]
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustIniSection [Char]
desc [Char]
header =
	[Char]
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustSection
	[Char]
desc
	(forall a. Eq a => a -> a -> Bool
== [Char] -> [Char]
iniHeader [Char]
header)
	([Char]
"[" 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 :: [Char] -> ([Char], [Char], [Char]) -> Property UnixLike
containsIniSetting [Char]
f ([Char]
header, [Char]
key, [Char]
value) = [Char]
-> [Char]
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustIniSection
	([Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" section [" forall a. [a] -> [a] -> [a]
++ [Char]
header forall a. [a] -> [a] -> [a]
++ [Char]
"] contains " forall a. [a] -> [a] -> [a]
++ [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
value)
	[Char]
header
	AdjustSection
go
	(forall a. [a] -> [a] -> [a]
++ [[Char]
confheader, [Char]
confline]) -- add missing section at end
	[Char]
f
  where
	confheader :: [Char]
confheader = [Char] -> [Char]
iniHeader [Char]
header
	confline :: [Char]
confline   = [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
value
	go :: AdjustSection
go []      = [[Char]
confline]
	go ([Char]
l:[[Char]]
ls)  = if SectionStart
isKeyVal [Char]
l then [Char]
confline forall a. a -> [a] -> [a]
: [[Char]]
ls else [Char]
l forall a. a -> [a] -> [a]
: AdjustSection
go [[Char]]
ls
	isKeyVal :: SectionStart
isKeyVal [Char]
x = (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=')) [Char]
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
key, Char
'#'forall a. a -> [a] -> [a]
:[Char]
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 :: [Char] -> ([Char], [Char], [Char]) -> Property UnixLike
lacksIniSetting [Char]
f ([Char]
header, [Char]
key, [Char]
value) = [Char]
-> [Char]
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustIniSection
	([Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" section [" forall a. [a] -> [a] -> [a]
++ [Char]
header forall a. [a] -> [a] -> [a]
++ [Char]
"] lacks " forall a. [a] -> [a] -> [a]
++ [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
value)
	[Char]
header
	(forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= [Char]
confline))
	forall a. a -> a
id
	[Char]
f
  where
	confline :: [Char]
confline = [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
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 :: [Char] -> [Char] -> [([Char], [Char])] -> Property UnixLike
hasIniSection [Char]
f [Char]
header [([Char], [Char])]
keyvalues = [Char]
-> [Char]
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustIniSection
	([Char]
"set " forall a. [a] -> [a] -> [a]
++ [Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" section [" forall a. [a] -> [a] -> [a]
++ [Char]
header forall a. [a] -> [a] -> [a]
++ [Char]
"]")
	[Char]
header
	forall {p}. p -> [[Char]]
go
	(forall a. [a] -> [a] -> [a]
++ [Char]
confheader forall a. a -> [a] -> [a]
: [[Char]]
conflines) -- add missing section at end
	[Char]
f
  where
	confheader :: [Char]
confheader = [Char] -> [Char]
iniHeader [Char]
header
	conflines :: [[Char]]
conflines  = forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
key, [Char]
value) -> [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
value) [([Char], [Char])]
keyvalues
	go :: p -> [[Char]]
go p
_       = [Char]
confheader forall a. a -> [a] -> [a]
: [[Char]]
conflines

-- | Ensures that a .ini file does not contain the specified section.
lacksIniSection :: FilePath -> IniSection -> Property UnixLike
lacksIniSection :: [Char] -> [Char] -> Property UnixLike
lacksIniSection [Char]
f [Char]
header = [Char]
-> [Char]
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustIniSection
	([Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" lacks section [" forall a. [a] -> [a] -> [a]
++ [Char]
header forall a. [a] -> [a] -> [a]
++ [Char]
"]")
	[Char]
header
	(forall a b. a -> b -> a
const []) -- remove all lines of section
	forall a. a -> a
id -- add no lines if section is missing
	[Char]
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 :: [Char]
-> [([Char], [([Char], [Char])])]
-> RevertableProperty UnixLike UnixLike
iniFileContains [Char]
f [([Char], [([Char], [Char])])]
l = [Char]
f [Char] -> [[Char]] -> Property UnixLike
`hasContent` [[Char]]
content forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> [Char] -> Property UnixLike
notPresent [Char]
f
  where
	content :: [[Char]]
content = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [([Char], [Char])]) -> [[Char]]
sectioncontent [([Char], [([Char], [Char])])]
l
	sectioncontent :: ([Char], [([Char], [Char])]) -> [[Char]]
sectioncontent ([Char]
section, [([Char], [Char])]
keyvalues) = [Char] -> [Char]
iniHeader [Char]
section forall a. a -> [a] -> [a]
:
		forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
key, [Char]
value) -> [Char]
key forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
value) [([Char], [Char])]
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 :: [Char] -> ([Char], [Char]) -> Property UnixLike
containsShellSetting [Char]
f ([Char]
k, [Char]
v) = Property UnixLike
adjust forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
dedup
  where
	adjust :: Property UnixLike
adjust = [Char]
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> [Char]
-> Property UnixLike
adjustSection
		([Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" contains " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
v)
		SectionStart
isline
		(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline)
		(forall a b. a -> b -> a
const [[Char]
line])
		(forall a. [a] -> [a] -> [a]
++ [[Char]
line])
		[Char]
f
	dedup :: Property UnixLike
dedup = forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty [Char]
"" forall {t :: * -> *}. Foldable t => t [Char] -> [[Char]]
dedup' [Char]
f
	dedup' :: t [Char] -> [[Char]]
dedup' t [Char]
ls = let ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([[Char]], [[Char]], [[Char]])
-> [Char] -> ([[Char]], [[Char]], [[Char]])
find ([], [], []) t [Char]
ls
		    in [[Char]]
pre forall a. [a] -> [a] -> [a]
++ [[Char]]
wanted forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
commentIfIsline [[Char]]
post
	find :: ([[Char]], [[Char]], [[Char]])
-> [Char] -> ([[Char]], [[Char]], [[Char]])
find ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post) [Char]
l
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
wanted Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline) [Char]
l = ([[Char]]
pre forall a. [a] -> [a] -> [a]
++ [[Char]
l], [[Char]]
wanted, [[Char]]
post)
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
wanted Bool -> Bool -> Bool
&& SectionStart
isline [Char]
l         = ([[Char]]
pre, [[Char]
l], [[Char]]
post)
		| Bool
otherwise                       = ([[Char]]
pre, [[Char]]
wanted, [[Char]]
post forall a. [a] -> [a] -> [a]
++ [[Char]
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 :: [Char] -> [Char]
commentIfIsline [Char]
l
		| SectionStart
isline [Char]
l  = Char
'#'forall a. a -> [a] -> [a]
:[Char]
l
		| Bool
otherwise = [Char]
l

	isline :: SectionStart
isline [Char]
s = ([Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"=") forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s
	line :: [Char]
line = [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shellEscape [Char]
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 :: [Char] -> ([Char], [Char]) -> Property UnixLike
lacksShellSetting [Char]
f ([Char]
k, [Char]
v) =
	forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty ([Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
"lacks shell setting " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
v) AdjustSection
go [Char]
f
  where
	go :: AdjustSection
go [[Char]]
ls = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
commentOut [[Char]]
ls
	commentOut :: [Char] -> [Char]
commentOut [Char]
l
		| ([Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"=") forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = Char
'#'forall a. a -> [a] -> [a]
:[Char]
l
		| Bool
otherwise                 = [Char]
l