{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}

module Propellor.Property.File where

import Propellor.Base

import qualified Data.ByteString.Lazy as L
import Data.List (isInfixOf, isPrefixOf)
import System.Posix.Files
import System.Exit
import Data.Char

type Line = String

-- | Replaces all the content of a file.
hasContent :: FilePath -> [Line] -> Property UnixLike
Line
f hasContent :: Line -> [Line] -> Property UnixLike
`hasContent` [Line]
newcontent = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty
	(Line
"replace " forall a. [a] -> [a] -> [a]
++ Line
f)
	(\[Line]
_oldcontent -> [Line]
newcontent) Line
f

-- | Ensures that a line is present in a file, adding it to the end if not.
--
-- For example:
--
-- >	& "/etc/default/daemon.conf" `File.containsLine` ("cachesize = " ++ val 1024)
--
-- The above example uses `val` to serialize a `ConfigurableValue`
containsLine :: FilePath -> Line -> Property UnixLike
Line
f containsLine :: Line -> Line -> Property UnixLike
`containsLine` Line
l = Line
f Line -> [Line] -> Property UnixLike
`containsLines` [Line
l]

-- | Ensures that a list of lines are present in a file, adding any that are not
-- to the end of the file.
--
-- Note that this property does not guarantee that the lines will appear
-- consecutively, nor in the order specified.  If you need either of these, use
-- 'File.containsBlock'.
containsLines :: FilePath -> [Line] -> Property UnixLike
Line
f containsLines :: Line -> [Line] -> Property UnixLike
`containsLines` [Line]
ls = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" contains:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
go Line
f
  where
	go :: [Line] -> [Line]
go [Line]
content = [Line]
content forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
content) [Line]
ls

-- | Ensures that a block of consecutive lines is present in a file, adding it
-- to the end if not.  Revert to ensure that the block is not present (though
-- the lines it contains could be present, non-consecutively).
containsBlock :: FilePath -> [Line] -> RevertableProperty UnixLike UnixLike
Line
f containsBlock :: Line -> [Line] -> RevertableProperty UnixLike UnixLike
`containsBlock` [Line]
ls =
	forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" contains block:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
add Line
f
	forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" lacks block:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
remove Line
f
  where
	add :: [Line] -> [Line]
add [Line]
content
		| [Line]
ls forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Line]
content = [Line]
content
		| Bool
otherwise              = [Line]
content forall a. [a] -> [a] -> [a]
++ [Line]
ls
	remove :: [Line] -> [Line]
remove [] = []
	remove content :: [Line]
content@(Line
x:[Line]
xs)
		| [Line]
ls forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Line]
content = [Line] -> [Line]
remove (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Line]
ls) [Line]
content)
		| Bool
otherwise = Line
x forall a. a -> [a] -> [a]
: [Line] -> [Line]
remove [Line]
xs

-- | Ensures that a line is not present in a file.
-- Note that the file is ensured to exist, so if it doesn't, an empty
-- file will be written.
lacksLine :: FilePath -> Line -> Property UnixLike
Line
f lacksLine :: Line -> Line -> Property UnixLike
`lacksLine` Line
l = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" remove: " forall a. [a] -> [a] -> [a]
++ Line
l) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Line
l)) Line
f

lacksLines :: FilePath -> [Line] -> Property UnixLike
Line
f lacksLines :: Line -> [Line] -> Property UnixLike
`lacksLines` [Line]
ls = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" remove: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [[Line]
ls]) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
ls)) Line
f

-- | Replaces all the content of a file, ensuring that its modes do not
-- allow it to be read or written by anyone other than the current user
hasContentProtected :: FilePath -> [Line] -> Property UnixLike
Line
f hasContentProtected :: Line -> [Line] -> Property UnixLike
`hasContentProtected` [Line]
newcontent = forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
ProtectedWrite
	(Line
"replace " forall a. [a] -> [a] -> [a]
++ Line
f)
	(\[Line]
_oldcontent -> [Line]
newcontent) Line
f

-- | Ensures a file has contents that comes from PrivData.
--
-- The file's permissions are preserved if the file already existed.
-- Otherwise, they're set to 600.
hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent :: forall c. IsContext c => Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent Line
f = forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom (PrivDataField -> Line -> PrivDataSource
PrivDataSourceFile (Line -> PrivDataField
PrivFile Line
f) Line
f) Line
f

-- | Like hasPrivContent, but allows specifying a source
-- for PrivData, rather than using `PrivDataSourceFile`.
hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom :: forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom = forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
ProtectedWrite

-- | Leaves the file at its default or current mode,
-- allowing "private" data to be read.
--
-- Use with caution!
hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposed :: forall c. IsContext c => Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposed Line
f = forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom (PrivDataField -> Line -> PrivDataSource
PrivDataSourceFile (Line -> PrivDataField
PrivFile Line
f) Line
f) Line
f

hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom :: forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom = forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
NormalWrite

hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent' :: forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
writemode s
source Line
f c
context = 
	forall c s metatypes.
(IsContext c, IsPrivDataSource s,
 IncludesInfo metatypes ~ 'True) =>
s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withPrivData s
source c
context forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getcontent -> 
		forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> (PrivData -> Propellor Result) -> Propellor Result
getcontent forall a b. (a -> b) -> a -> b
$ \PrivData
privcontent -> 
			forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o forall a b. (a -> b) -> a -> b
$ forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
writemode Line
desc
				(\ByteString
_oldcontent -> PrivData -> ByteString
privDataByteString PrivData
privcontent) Line
f
  where
	desc :: Line
desc = Line
"privcontent " forall a. [a] -> [a] -> [a]
++ Line
f

-- | Replaces the content of a file with the transformed content of another file
basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike
Line
f basedOn :: Line -> (Line, [Line] -> [Line]) -> Property UnixLike
`basedOn` (Line
src, [Line] -> [Line]
a) = forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> do
	Line
tmpl <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readFile Line
src
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o forall a b. (a -> b) -> a -> b
$ forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty Line
desc (\[Line]
_ -> [Line] -> [Line]
a forall a b. (a -> b) -> a -> b
$ Line -> [Line]
lines forall a b. (a -> b) -> a -> b
$ Line
tmpl) Line
f
  where
	desc :: Line
desc = Line
f forall a. [a] -> [a] -> [a]
++ Line
" is based on " forall a. [a] -> [a] -> [a]
++ Line
src

-- | Removes a file. Does not remove symlinks or non-plain-files.
notPresent :: FilePath -> Property UnixLike
notPresent :: Line -> Property UnixLike
notPresent Line
f = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Line -> IO Bool
doesFileExist Line
f) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f forall a. [a] -> [a] -> [a]
++ Line
" not present") forall a b. (a -> b) -> a -> b
$ 
	IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
nukeFile Line
f

-- | Ensures a directory exists.
dirExists :: FilePath -> Property UnixLike
dirExists :: Line -> Property UnixLike
dirExists Line
d = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesDirectoryExist Line
d) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
d forall a. [a] -> [a] -> [a]
++ Line
" exists") forall a b. (a -> b) -> a -> b
$
	IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Bool -> Line -> IO ()
createDirectoryIfMissing Bool
True Line
d

-- | The location that a symbolic link points to.
newtype LinkTarget = LinkTarget FilePath

-- | Creates or atomically updates a symbolic link.
--
-- Revert to ensure no symlink is present.
--
-- Does not overwrite or delete regular files or directories.
isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike
Line
link isSymlinkedTo :: Line -> LinkTarget -> RevertableProperty UnixLike UnixLike
`isSymlinkedTo` (LinkTarget Line
target) = Property UnixLike
linked forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
notLinked
  where
	linked :: Property UnixLike
linked = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link forall a. [a] -> [a] -> [a]
++ Line
" is symlinked to " forall a. [a] -> [a] -> [a]
++ Line
target) forall a b. (a -> b) -> a -> b
$
		forall {a}. Either a FileStatus -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Either IOException FileStatus)
getLinkStatus

	go :: Either a FileStatus -> Propellor Result
go (Right FileStatus
stat) =
		if FileStatus -> Bool
isSymbolicLink FileStatus
stat
			then Propellor Result
checkLink
			else Propellor Result
nonSymlinkExists
	go (Left a
_) = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
createSymbolicLink Line
target Line
link

	notLinked :: Property UnixLike
notLinked = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link forall a. [a] -> [a] -> [a]
++ Line
"does not exist as a symlink") forall a b. (a -> b) -> a -> b
$
		forall {a}. Either a FileStatus -> Propellor Result
stop forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Either IOException FileStatus)
getLinkStatus

	stop :: Either a FileStatus -> Propellor Result
stop (Right FileStatus
stat) =
		if FileStatus -> Bool
isSymbolicLink FileStatus
stat
			then IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
nukeFile Line
link
			else Propellor Result
nonSymlinkExists
	stop (Left a
_) = Propellor Result
noChange

	nonSymlinkExists :: Propellor Result
nonSymlinkExists = do
		forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ Line
link forall a. [a] -> [a] -> [a]
++ Line
" exists and is not a symlink"
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
	checkLink :: Propellor Result
checkLink = do
		Line
target' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readSymbolicLink Line
link
		if Line
target forall a. Eq a => a -> a -> Bool
== Line
target'
			then Propellor Result
noChange
			else IO () -> Propellor Result
makeChange IO ()
updateLink
	updateLink :: IO ()
updateLink = Line -> Line -> IO ()
createSymbolicLink Line
target forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
link

	getLinkStatus :: Propellor (Either IOException FileStatus)
getLinkStatus = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO FileStatus
getSymbolicLinkStatus Line
link

-- | Ensures that a file is a copy of another (regular) file.
isCopyOf :: FilePath -> FilePath -> Property UnixLike
Line
f isCopyOf :: Line -> Line -> Property UnixLike
`isCopyOf` Line
src = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => Either a FileStatus -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO FileStatus
getFileStatus Line
src)
  where
	desc :: Line
desc = Line
f forall a. [a] -> [a] -> [a]
++ Line
" is copy of " forall a. [a] -> [a] -> [a]
++ Line
src
	go :: Either a FileStatus -> Propellor Result
go (Right FileStatus
stat) = if FileStatus -> Bool
isRegularFile FileStatus
stat
		then forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Bool
doesFileExist Line
f)
			( ExitCode -> Propellor Result
gocmp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO ExitCode
cmp)
			, Propellor Result
doit
			)
		else forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (Line
src forall a. [a] -> [a] -> [a]
++ Line
" is not a regular file") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
			forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
	go (Left a
e) = forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (forall a. Show a => a -> Line
show a
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange

	cmp :: IO ExitCode
cmp = Line -> [CommandParam] -> IO ExitCode
safeSystem Line
"cmp" [Line -> CommandParam
Param Line
"-s", Line -> CommandParam
Param Line
"--", Line -> CommandParam
File Line
f, Line -> CommandParam
File Line
src]
	gocmp :: ExitCode -> Propellor Result
gocmp ExitCode
ExitSuccess = Propellor Result
noChange
	gocmp (ExitFailure Int
1) = Propellor Result
doit
	gocmp ExitCode
_ = forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage Line
"cmp failed" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange

	doit :: Propellor Result
doit = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
copy forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
	copy :: Line -> IO ()
copy Line
dest = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (Line -> IO Bool
runcp Line
dest) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Line -> m a
errorMessage Line
"cp failed"
	runcp :: Line -> IO Bool
runcp Line
dest = Line -> [CommandParam] -> IO Bool
boolSystem Line
"cp"
		[Line -> CommandParam
Param Line
"--preserve=all", Line -> CommandParam
Param Line
"--", Line -> CommandParam
File Line
src, Line -> CommandParam
File Line
dest]

-- | Ensures that a file/dir has the specified owner and group.
ownerGroup :: FilePath -> User -> Group -> Property UnixLike
ownerGroup :: Line -> User -> Group -> Property UnixLike
ownerGroup Line
f (User Line
owner) (Group Line
group) = Property UnixLike
p forall p. IsProp p => p -> Line -> p
`describe` (Line
f forall a. [a] -> [a] -> [a]
++ Line
" owner " forall a. [a] -> [a] -> [a]
++ Line
og)
  where
	p :: Property UnixLike
p = Line -> [Line] -> UncheckedProperty UnixLike
cmdProperty Line
"chown" [Line
og, Line
f]
		forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
	og :: Line
og = Line
owner forall a. [a] -> [a] -> [a]
++ Line
":" forall a. [a] -> [a] -> [a]
++ Line
group

-- | Given a base directory, and a relative path under that
-- directory, applies a property to each component of the path in turn, 
-- starting with the base directory.
--
-- For example, to make a file owned by a user, making sure their home
-- directory and the subdirectories to it are also owned by them:
--
-- > "/home/user/program/file" `hasContent` ["foo"]
-- > 	`before` applyPath "/home/user" ".config/program/file" 
-- > 		(\f -> ownerGroup f (User "user") (Group "user"))
applyPath :: Monoid (Property metatypes) => FilePath -> FilePath -> (FilePath -> Property metatypes) -> Property metatypes
applyPath :: forall metatypes.
Monoid (Property metatypes) =>
Line -> Line -> (Line -> Property metatypes) -> Property metatypes
applyPath Line
basedir Line
relpath Line -> Property metatypes
mkp = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 
	forall a b. (a -> b) -> [a] -> [b]
map Line -> Property metatypes
mkp (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Line -> Line -> Line
(</>) Line
basedir (Line -> [Line]
splitPath Line
relpath))

-- | Ensures that a file/dir has the specfied mode.
mode :: FilePath -> FileMode -> Property UnixLike
mode :: Line -> FileMode -> Property UnixLike
mode Line
f FileMode
v = Property UnixLike
p forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
  where
	p :: Property UnixLike
p = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f forall a. [a] -> [a] -> [a]
++ Line
" mode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show FileMode
v) forall a b. (a -> b) -> a -> b
$ do
		forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> (FileMode -> FileMode) -> IO ()
modifyFileMode Line
f (forall a b. a -> b -> a
const FileMode
v)
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange

class FileContent c where
	emptyFileContent :: c
	readFileContent :: FilePath -> IO c
	writeFileContent :: FileWriteMode -> FilePath -> c -> IO ()

data FileWriteMode = NormalWrite | ProtectedWrite

instance FileContent [Line] where
	emptyFileContent :: [Line]
emptyFileContent = []
	readFileContent :: Line -> IO [Line]
readFileContent Line
f = Line -> [Line]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Line
readFile Line
f
	writeFileContent :: FileWriteMode -> Line -> [Line] -> IO ()
writeFileContent FileWriteMode
NormalWrite Line
f [Line]
ls = Line -> Line -> IO ()
writeFile Line
f ([Line] -> Line
unlines [Line]
ls)
	writeFileContent FileWriteMode
ProtectedWrite Line
f [Line]
ls = Line -> Line -> IO ()
writeFileProtected Line
f ([Line] -> Line
unlines [Line]
ls)

instance FileContent L.ByteString where
	emptyFileContent :: ByteString
emptyFileContent = ByteString
L.empty
	readFileContent :: Line -> IO ByteString
readFileContent = Line -> IO ByteString
L.readFile
	writeFileContent :: FileWriteMode -> Line -> ByteString -> IO ()
writeFileContent FileWriteMode
NormalWrite Line
f ByteString
c = Line -> ByteString -> IO ()
L.writeFile Line
f ByteString
c
	writeFileContent FileWriteMode
ProtectedWrite Line
f ByteString
c = 
		Line -> (Handle -> IO ()) -> IO ()
writeFileProtected' Line
f (Handle -> ByteString -> IO ()
`L.hPutStr` ByteString
c)

-- | A property that applies a pure function to the content of a file.
fileProperty :: (FileContent c, Eq c) => Desc -> (c -> c) -> FilePath -> Property UnixLike
fileProperty :: forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty = forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
NormalWrite
fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' :: forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
writemode Line
desc c -> c
a Line
f = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc forall a b. (a -> b) -> a -> b
$ Bool -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Line -> IO Bool
doesFileExist Line
f)
  where
	go :: Bool -> Propellor Result
go Bool
True = do
		c
old <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall c. FileContent c => Line -> IO c
readFileContent Line
f
		let new :: c
new = c -> c
a c
old
		if c
old forall a. Eq a => a -> a -> Bool
== c
new
			then Propellor Result
noChange
			else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ c -> Line -> IO ()
updatefile c
new forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
	go Bool
False = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> c -> IO ()
writer Line
f (c -> c
a forall c. FileContent c => c
emptyFileContent)

	-- Replicate the original file's owner and mode.
	updatefile :: c -> Line -> IO ()
updatefile c
content Line
dest = do
		Line -> c -> IO ()
writer Line
dest c
content
		FileStatus
s <- Line -> IO FileStatus
getFileStatus Line
f
		Line -> FileMode -> IO ()
setFileMode Line
dest (FileStatus -> FileMode
fileMode FileStatus
s)
		Line -> UserID -> GroupID -> IO ()
setOwnerAndGroup Line
dest (FileStatus -> UserID
fileOwner FileStatus
s) (FileStatus -> GroupID
fileGroup FileStatus
s)
	
	writer :: Line -> c -> IO ()
writer = forall c. FileContent c => FileWriteMode -> Line -> c -> IO ()
writeFileContent FileWriteMode
writemode

-- | A temp file to use when writing new content for a file.
--
-- This is a stable name so it can be removed idempotently.
--
-- It ends with "~" so that programs that read many config files from a
-- directory will treat it as an editor backup file, and not read it.
stableTmpFor :: FilePath -> FilePath
stableTmpFor :: Line -> Line
stableTmpFor Line
f = Line
f forall a. [a] -> [a] -> [a]
++ Line
".propellor-new~"

-- | Creates/updates a file atomically, running the action to create the
-- stable tmp file, and then renaming it into place.
viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()
viaStableTmp :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
viaStableTmp Line -> m ()
a Line
f = forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO Line
setup Line -> IO (Either IOException ())
cleanup Line -> m ()
go
  where
	setup :: IO Line
setup = do
		Bool -> Line -> IO ()
createDirectoryIfMissing Bool
True (Line -> Line
takeDirectory Line
f)
		let tmpfile :: Line
tmpfile = Line -> Line
stableTmpFor Line
f
		Line -> IO ()
nukeFile Line
tmpfile
		forall (m :: * -> *) a. Monad m => a -> m a
return Line
tmpfile
	cleanup :: Line -> IO (Either IOException ())
cleanup Line
tmpfile = forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO ()
removeFile Line
tmpfile
	go :: Line -> m ()
go Line
tmpfile = do
		Line -> m ()
a Line
tmpfile
		forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
rename Line
tmpfile Line
f

-- | Generates a base configuration file name from a String, which
-- can be put in a configuration directory, such as
-- </etc/apt/sources.list.d/>
--
-- The generated file name is limited to using ASCII alphanumerics,
-- \'_\' and \'.\' , so that programs that only accept a limited set of
-- characters will accept it. Any other characters will be encoded
-- in escaped form.
--
-- Some file extensions, such as ".old" may be filtered out by
-- programs that use configuration directories. To avoid such problems,
-- it's a good idea to add an static prefix and extension to the 
-- result of this function. For example:
--
-- > aptConf foo = "/etc/apt/apt.conf.d" </> "propellor_" ++ configFileName foo <.> ".conf"
configFileName :: String -> FilePath
configFileName :: Line -> Line
configFileName = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> Line
escape
  where
	escape :: Char -> Line
escape Char
c
		| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c = [Char
c]
		| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' = [Char
c]
		| Bool
otherwise = Char
'_' forall a. a -> [a] -> [a]
: forall a. Show a => a -> Line
show (Char -> Int
ord Char
c)

-- | Applies configFileName to any value that can be shown.
showConfigFileName :: Show v => v -> FilePath
showConfigFileName :: forall a. Show a => a -> Line
showConfigFileName = Line -> Line
configFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Line
show

-- | Inverse of showConfigFileName.
readConfigFileName :: Read v => FilePath -> Maybe v
readConfigFileName :: forall v. Read v => Line -> Maybe v
readConfigFileName = forall v. Read v => Line -> Maybe v
readish forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Line
unescape
  where
	unescape :: Line -> Line
unescape [] = []
	unescape (Char
'_':Line
cs) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) Line
cs of
		([], Line
_) -> Char
'_' forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs
		(Line
ns, Line
cs') -> case forall v. Read v => Line -> Maybe v
readish Line
ns of
			Maybe Int
Nothing -> Char
'_' forall a. a -> [a] -> [a]
: Line
ns forall a. [a] -> [a] -> [a]
++ Line -> Line
unescape Line
cs'
			Just Int
n -> Int -> Char
chr Int
n forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs'
	unescape (Char
c:Line
cs) = Char
c forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs

data Overwrite = OverwriteExisting | PreserveExisting

-- | When passed PreserveExisting, only ensures the property when the file
-- does not exist.
checkOverwrite :: Overwrite -> FilePath -> (FilePath -> Property i) -> Property i
checkOverwrite :: forall i. Overwrite -> Line -> (Line -> Property i) -> Property i
checkOverwrite Overwrite
OverwriteExisting Line
f Line -> Property i
mkp = Line -> Property i
mkp Line
f
checkOverwrite Overwrite
PreserveExisting Line
f Line -> Property i
mkp = 
	forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesFileExist Line
f) (Line -> Property i
mkp Line
f)