module Propellor.Property (
requires
, before
, onChange
, onChangeFlagOnFail
, flagFile
, flagFile'
, check
, fallback
, revert
, describe
, (==>)
, Propellor
, property
, ensureProperty
, withOS
, makeChange
, noChange
, doNothing
, endAction
, UncheckedProperty
, unchecked
, changesFile
, changesFileContent
, isNewerThan
, checkResult
, Checkable
, assume
) where
import System.Directory
import System.FilePath
import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
import "mtl" Control.Monad.RWS.Strict
import System.Posix.Files
import qualified Data.Hash.MD5 as MD5
import Control.Applicative
import Prelude
import Propellor.Types
import Propellor.Types.ResultCheck
import Propellor.Info
import Propellor.Exception
import Utility.Exception
import Utility.Monad
import Utility.Misc
property :: Desc -> Propellor Result -> Property NoInfo
property d s = simpleProperty d s mempty
flagFile :: Property i -> FilePath -> Property i
flagFile p = flagFile' p . return
flagFile' :: Property i -> IO FilePath -> Property i
flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
flagfile <- liftIO getflagfile
go satisfy flagfile =<< liftIO (doesFileExist flagfile)
where
go _ _ True = return NoChange
go satisfy flagfile False = do
r <- satisfy
when (r == MadeChange) $ liftIO $
unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
writeFile flagfile ""
return r
requires :: Combines x y => x -> y -> CombinedType x y
requires = combineWith
(flip (<>))
(<>)
before :: Combines x y => x -> y -> CombinedType x y
before = combineWith
(<>)
(flip (<>))
onChange
:: (Combines x y)
=> x
-> y
-> CombinedType x y
onChange = combineWith combiner revertcombiner
where
combiner p hook = do
r <- p
case r of
MadeChange -> do
r' <- hook
return $ r <> r'
_ -> return r
revertcombiner = (<>)
onChangeFlagOnFail
:: (Combines x y)
=> FilePath
-> x
-> y
-> CombinedType x y
onChangeFlagOnFail flagfile = combineWith combiner revertcombiner
where
combiner s1 s2 = do
r1 <- s1
case r1 of
MadeChange -> flagFailed s2
_ -> ifM (liftIO $ doesFileExist flagfile)
(flagFailed s2
, return r1
)
revertcombiner = (<>)
flagFailed s = do
r <- s
liftIO $ case r of
FailedChange -> createFlagFile
_ -> removeFlagFile
return r
createFlagFile = unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
writeFile flagfile ""
removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile
describe :: IsProp p => p -> Desc -> p
describe = setDesc
(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
(==>) = flip describe
infixl 1 ==>
ensureProperty :: Property NoInfo -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
fallback = combineWith combiner revertcombiner
where
combiner a1 a2 = do
r <- a1
if r == FailedChange
then a2
else return r
revertcombiner = (<>)
changesFile :: Checkable p i => p i -> FilePath -> Property i
changesFile p f = checkResult getstat comparestat p
where
getstat = catchMaybeIO $ getSymbolicLinkStatus f
comparestat oldstat = do
newstat <- getstat
return $ if samestat oldstat newstat then NoChange else MadeChange
samestat Nothing Nothing = True
samestat (Just a) (Just b) = and
[ deviceID a == deviceID b
, fileID a == fileID b
, fileMode a == fileMode b
, fileOwner a == fileOwner b
, fileGroup a == fileGroup b
, specialDeviceID a == specialDeviceID b
, fileSize a == fileSize b
, modificationTimeHiRes a == modificationTimeHiRes b
, isBlockDevice a == isBlockDevice b
, isCharacterDevice a == isCharacterDevice b
, isNamedPipe a == isNamedPipe b
, isRegularFile a == isRegularFile b
, isDirectory a == isDirectory b
, isSymbolicLink a == isSymbolicLink b
, isSocket a == isSocket b
]
samestat _ _ = False
changesFileContent :: Checkable p i => p i -> FilePath -> Property i
changesFileContent p f = checkResult getmd5 comparemd5 p
where
getmd5 = catchMaybeIO $ MD5.md5 . MD5.Str <$> readFileStrictAnyEncoding f
comparemd5 oldmd5 = do
newmd5 <- getmd5
return $ if oldmd5 == newmd5 then NoChange else MadeChange
isNewerThan :: FilePath -> FilePath -> IO Bool
isNewerThan x y = do
mx <- mtime x
my <- mtime y
return (mx > my)
where
mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
revert :: RevertableProperty i -> RevertableProperty i
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
noChange :: Propellor Result
noChange = return NoChange
doNothing :: Property NoInfo
doNothing = property "noop property" noChange
endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
endAction desc a = tell [EndAction desc a]