{-# 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
FilePath
f hasContent :: FilePath -> [FilePath] -> Property UnixLike
`hasContent` [FilePath]
newcontent = FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty
	(FilePath
"replace " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f)
	(\[FilePath]
_oldcontent -> [FilePath]
newcontent) FilePath
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
FilePath
f containsLine :: FilePath -> FilePath -> Property UnixLike
`containsLine` FilePath
l = FilePath
f FilePath -> [FilePath] -> Property UnixLike
`containsLines` [FilePath
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
FilePath
f containsLines :: FilePath -> [FilePath] -> Property UnixLike
`containsLines` [FilePath]
ls = FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" contains:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
ls) [FilePath] -> [FilePath]
go FilePath
f
  where
	go :: [FilePath] -> [FilePath]
go [FilePath]
content = [FilePath]
content [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
content) [FilePath]
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
FilePath
f containsBlock :: FilePath -> [FilePath] -> RevertableProperty UnixLike UnixLike
`containsBlock` [FilePath]
ls =
	FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" contains block:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
ls) [FilePath] -> [FilePath]
add FilePath
f
	Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" lacks block:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
ls) [FilePath] -> [FilePath]
remove FilePath
f
  where
	add :: [FilePath] -> [FilePath]
add [FilePath]
content
		| [FilePath]
ls [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [FilePath]
content = [FilePath]
content
		| Bool
otherwise              = [FilePath]
content [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ls
	remove :: [FilePath] -> [FilePath]
remove [] = []
	remove content :: [FilePath]
content@(FilePath
x:[FilePath]
xs)
		| [FilePath]
ls [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [FilePath]
content = [FilePath] -> [FilePath]
remove (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ls) [FilePath]
content)
		| Bool
otherwise = FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
remove [FilePath]
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
FilePath
f lacksLine :: FilePath -> FilePath -> Property UnixLike
`lacksLine` FilePath
l = FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" remove: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l) ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
l)) FilePath
f

lacksLines :: FilePath -> [Line] -> Property UnixLike
FilePath
f lacksLines :: FilePath -> [FilePath] -> Property UnixLike
`lacksLines` [FilePath]
ls = FilePath
-> ([FilePath] -> [FilePath]) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" remove: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [[FilePath]] -> FilePath
forall a. Show a => a -> FilePath
show [[FilePath]
ls]) ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
ls)) FilePath
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
FilePath
f hasContentProtected :: FilePath -> [FilePath] -> Property UnixLike
`hasContentProtected` [FilePath]
newcontent = FileWriteMode
-> FilePath
-> ([FilePath] -> [FilePath])
-> FilePath
-> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FileWriteMode
-> FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' FileWriteMode
ProtectedWrite
	(FilePath
"replace " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f)
	(\[FilePath]
_oldcontent -> [FilePath]
newcontent) FilePath
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 :: FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent FilePath
f = PrivDataSource -> FilePath -> c -> Property (HasInfo + UnixLike)
forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom (PrivDataField -> FilePath -> PrivDataSource
PrivDataSourceFile (FilePath -> PrivDataField
PrivFile FilePath
f) FilePath
f) FilePath
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 :: s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom = FileWriteMode
-> s -> FilePath -> c -> Property (HasInfo + UnixLike)
forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode
-> s -> FilePath -> 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 :: FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposed FilePath
f = PrivDataSource -> FilePath -> c -> Property (HasInfo + UnixLike)
forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom (PrivDataField -> FilePath -> PrivDataSource
PrivDataSourceFile (FilePath -> PrivDataField
PrivFile FilePath
f) FilePath
f) FilePath
f

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

hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent' :: FileWriteMode
-> s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
writemode s
source FilePath
f c
context = 
	s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 ((((PrivData -> Propellor Result) -> Propellor Result)
  -> Property
       (MetaTypes
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getcontent -> 
		FilePath
-> (OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
desc ((OuterMetaTypesWitness
    '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
  -> Propellor Result)
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> (PrivData -> Propellor Result) -> Propellor Result
getcontent ((PrivData -> Propellor Result) -> Propellor Result)
-> (PrivData -> Propellor Result) -> Propellor Result
forall a b. (a -> b) -> a -> b
$ \PrivData
privcontent -> 
			OuterMetaTypesWitness
  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> Propellor Result
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 (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FileWriteMode
-> FilePath
-> (ByteString -> ByteString)
-> FilePath
-> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FileWriteMode
-> FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' FileWriteMode
writemode FilePath
desc
				(\ByteString
_oldcontent -> PrivData -> ByteString
privDataByteString PrivData
privcontent) FilePath
f
  where
	desc :: FilePath
desc = FilePath
"privcontent " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f

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

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

-- | Ensures a directory exists.
dirExists :: FilePath -> Property UnixLike
dirExists :: FilePath -> Property UnixLike
dirExists FilePath
d = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesDirectoryExist FilePath
d) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" exists") (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
	IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
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
FilePath
link isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike
`isSymlinkedTo` (LinkTarget FilePath
target) = Property UnixLike
linked Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
notLinked
  where
	linked :: Property UnixLike
linked = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
link FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is symlinked to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
target) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
		Either IOException FileStatus -> Propellor Result
forall a. Either a FileStatus -> Propellor Result
go (Either IOException FileStatus -> Propellor Result)
-> Propellor (Either IOException FileStatus) -> Propellor Result
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 (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
target FilePath
link

	notLinked :: Property UnixLike
notLinked = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
link FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"does not exist as a symlink") (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
		Either IOException FileStatus -> Propellor Result
forall a. Either a FileStatus -> Propellor Result
stop (Either IOException FileStatus -> Propellor Result)
-> Propellor (Either IOException FileStatus) -> Propellor Result
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 (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
nukeFile FilePath
link
			else Propellor Result
nonSymlinkExists
	stop (Left a
_) = Propellor Result
noChange

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

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

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

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

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

-- | Ensures that a file/dir has the specified owner and group.
ownerGroup :: FilePath -> User -> Group -> Property UnixLike
ownerGroup :: FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
f (User FilePath
owner) (Group FilePath
group) = Property UnixLike
p Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" owner " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
og)
  where
	p :: Property UnixLike
p = FilePath -> [FilePath] -> UncheckedProperty UnixLike
cmdProperty FilePath
"chown" [FilePath
og, FilePath
f]
		UncheckedProperty UnixLike -> FilePath -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFile` FilePath
f
	og :: FilePath
og = FilePath
owner FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
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 :: FilePath
-> FilePath
-> (FilePath -> Property metatypes)
-> Property metatypes
applyPath FilePath
basedir FilePath
relpath FilePath -> Property metatypes
mkp = [Property metatypes] -> Property metatypes
forall a. Monoid a => [a] -> a
mconcat ([Property metatypes] -> Property metatypes)
-> [Property metatypes] -> Property metatypes
forall a b. (a -> b) -> a -> b
$ 
	(FilePath -> Property metatypes)
-> [FilePath] -> [Property metatypes]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Property metatypes
mkp ((FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> [FilePath]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl FilePath -> FilePath -> FilePath
(</>) FilePath
basedir (FilePath -> [FilePath]
splitPath FilePath
relpath))

-- | Ensures that a file/dir has the specfied mode.
mode :: FilePath -> FileMode -> Property UnixLike
mode :: FilePath -> FileMode -> Property UnixLike
mode FilePath
f FileMode
v = Property UnixLike
p Property UnixLike -> FilePath -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFile` FilePath
f
  where
	p :: Property UnixLike
p = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" mode " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FileMode -> FilePath
forall a. Show a => a -> FilePath
show FileMode
v) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
		IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode FilePath
f (FileMode -> FileMode -> FileMode
forall a b. a -> b -> a
const FileMode
v)
		Result -> Propellor Result
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 :: [FilePath]
emptyFileContent = []
	readFileContent :: FilePath -> IO [FilePath]
readFileContent FilePath
f = FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
f
	writeFileContent :: FileWriteMode -> FilePath -> [FilePath] -> IO ()
writeFileContent FileWriteMode
NormalWrite FilePath
f [FilePath]
ls = FilePath -> FilePath -> IO ()
writeFile FilePath
f ([FilePath] -> FilePath
unlines [FilePath]
ls)
	writeFileContent FileWriteMode
ProtectedWrite FilePath
f [FilePath]
ls = FilePath -> FilePath -> IO ()
writeFileProtected FilePath
f ([FilePath] -> FilePath
unlines [FilePath]
ls)

instance FileContent L.ByteString where
	emptyFileContent :: ByteString
emptyFileContent = ByteString
L.empty
	readFileContent :: FilePath -> IO ByteString
readFileContent = FilePath -> IO ByteString
L.readFile
	writeFileContent :: FileWriteMode -> FilePath -> ByteString -> IO ()
writeFileContent FileWriteMode
NormalWrite FilePath
f ByteString
c = FilePath -> ByteString -> IO ()
L.writeFile FilePath
f ByteString
c
	writeFileContent FileWriteMode
ProtectedWrite FilePath
f ByteString
c = 
		FilePath -> (Handle -> IO ()) -> IO ()
writeFileProtected' FilePath
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 :: FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty = FileWriteMode
-> FilePath -> (c -> c) -> FilePath -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FileWriteMode
-> FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' FileWriteMode
NormalWrite
fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' :: FileWriteMode
-> FilePath -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' FileWriteMode
writemode FilePath
desc c -> c
a FilePath
f = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Bool -> Propellor Result
go (Bool -> Propellor Result) -> Propellor Bool -> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool -> Propellor Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
f)
  where
	go :: Bool -> Propellor Result
go Bool
True = do
		c
old <- IO c -> Propellor c
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> Propellor c) -> IO c -> Propellor c
forall a b. (a -> b) -> a -> b
$ FilePath -> IO c
forall c. FileContent c => FilePath -> IO c
readFileContent FilePath
f
		let new :: c
new = c -> c
a c
old
		if c
old c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
new
			then Propellor Result
noChange
			else IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ c -> FilePath -> IO ()
updatefile c
new (FilePath -> IO ()) -> FilePath -> IO ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(FilePath -> m ()) -> FilePath -> m ()
`viaStableTmp` FilePath
f
	go Bool
False = IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FilePath -> c -> IO ()
writer FilePath
f (c -> c
a c
forall c. FileContent c => c
emptyFileContent)

	-- Replicate the original file's owner and mode.
	updatefile :: c -> FilePath -> IO ()
updatefile c
content FilePath
dest = do
		FilePath -> c -> IO ()
writer FilePath
dest c
content
		FileStatus
s <- FilePath -> IO FileStatus
getFileStatus FilePath
f
		FilePath -> FileMode -> IO ()
setFileMode FilePath
dest (FileStatus -> FileMode
fileMode FileStatus
s)
		FilePath -> UserID -> GroupID -> IO ()
setOwnerAndGroup FilePath
dest (FileStatus -> UserID
fileOwner FileStatus
s) (FileStatus -> GroupID
fileGroup FileStatus
s)
	
	writer :: FilePath -> c -> IO ()
writer = FileWriteMode -> FilePath -> c -> IO ()
forall c. FileContent c => FileWriteMode -> FilePath -> 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 :: FilePath -> FilePath
stableTmpFor FilePath
f = FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".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 :: (FilePath -> m ()) -> FilePath -> m ()
viaStableTmp FilePath -> m ()
a FilePath
f = IO FilePath
-> (FilePath -> IO (Either IOException ()))
-> (FilePath -> m ())
-> m ()
forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO FilePath
setup FilePath -> IO (Either IOException ())
cleanup FilePath -> m ()
go
  where
	setup :: IO FilePath
setup = do
		Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
f)
		let tmpfile :: FilePath
tmpfile = FilePath -> FilePath
stableTmpFor FilePath
f
		FilePath -> IO ()
nukeFile FilePath
tmpfile
		FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
tmpfile
	cleanup :: FilePath -> IO (Either IOException ())
cleanup FilePath
tmpfile = IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
tmpfile
	go :: FilePath -> m ()
go FilePath
tmpfile = do
		FilePath -> m ()
a FilePath
tmpfile
		IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
rename FilePath
tmpfile FilePath
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 :: FilePath -> FilePath
configFileName = (Char -> FilePath) -> FilePath -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> FilePath
escape
  where
	escape :: Char -> FilePath
escape Char
c
		| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c = [Char
c]
		| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = [Char
c]
		| Bool
otherwise = Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show (Char -> Int
ord Char
c)

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

-- | Inverse of showConfigFileName.
readConfigFileName :: Read v => FilePath -> Maybe v
readConfigFileName :: FilePath -> Maybe v
readConfigFileName = FilePath -> Maybe v
forall a. Read a => FilePath -> Maybe a
readish (FilePath -> Maybe v)
-> (FilePath -> FilePath) -> FilePath -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
unescape
  where
	unescape :: FilePath -> FilePath
unescape [] = []
	unescape (Char
'_':FilePath
cs) = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) FilePath
cs of
		([], FilePath
_) -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
unescape FilePath
cs
		(FilePath
ns, FilePath
cs') -> case FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readish FilePath
ns of
			Maybe Int
Nothing -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
ns FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
unescape FilePath
cs'
			Just Int
n -> Int -> Char
chr Int
n Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
unescape FilePath
cs'
	unescape (Char
c:FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
unescape FilePath
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 :: Overwrite -> FilePath -> (FilePath -> Property i) -> Property i
checkOverwrite Overwrite
OverwriteExisting FilePath
f FilePath -> Property i
mkp = FilePath -> Property i
mkp FilePath
f
checkOverwrite Overwrite
PreserveExisting FilePath
f FilePath -> Property i
mkp = 
	IO Bool -> Property i -> Property i
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
f) (FilePath -> Property i
mkp FilePath
f)