summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-12-06 06:34:32 -0400
committerJoey Hess2014-12-06 06:34:32 -0400
commitfcff7762e395378791f01c9ea8507b41a4d7d501 (patch)
treec5f3c910e93a7741c3326e729140dbd8b210e36b /src
parentc97dd0d7088fa981f762070e06fc8058ab04cdbd (diff)
endAction can be used to register an action to run once propellor has successfully run on a host.
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Engine.hs37
-rw-r--r--src/Propellor/Property.hs11
-rw-r--r--src/Propellor/Types.hs15
3 files changed, 49 insertions, 14 deletions
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 81cc2397..310f4c84 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -7,7 +7,7 @@ import System.IO
import Data.Monoid
import Control.Applicative
import System.Console.ANSI
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
import Control.Exception (bracket)
import System.PosixCompat
import System.Posix.IO
@@ -22,21 +22,37 @@ import Utility.Exception
import Utility.PartialPrelude
import Utility.Monad
-runPropellor :: Host -> Propellor a -> IO a
-runPropellor host a = runReaderT (runWithHost a) host
-
+-- | Gets the Properties of a Host, and ensures them all,
+-- with nice display of what's being done.
mainProperties :: Host -> IO ()
mainProperties host = do
- r <- runPropellor host $
+ ret <- runPropellor host $
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
h <- mkMessageHandle
whenConsole h $
setTitle "propellor: done"
hFlush stdout
- case r of
+ case ret of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
+-- | Runs a Propellor action with the specified host.
+--
+-- If the Result is not FailedChange, any EndActions
+-- that were accumulated while running the action
+-- are then also run.
+runPropellor :: Host -> Propellor Result -> IO Result
+runPropellor host a = do
+ (ret, _s, endactions) <- runRWST (runWithHost a) host ()
+ endrets <- mapM (runEndAction host) endactions
+ return $ mconcat (ret:endrets)
+
+runEndAction :: Host -> EndAction -> IO Result
+runEndAction host (EndAction desc a) = actionMessageOn (hostName host) desc $ do
+ (ret, _s, _) <- runRWST (runWithHost (catchPropellor a)) host ()
+ return ret
+
+-- | Ensures a list of Properties, with a display of each as it runs.
ensureProperties :: [Property] -> Propellor Result
ensureProperties ps = ensure ps NoChange
where
@@ -46,6 +62,8 @@ ensureProperties ps = ensure ps NoChange
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
ensure ls (r <> rs)
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
ensureProperty :: Property -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
@@ -55,8 +73,11 @@ ensureProperty = catchPropellor . propertySatisfy
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of
Nothing -> return Nothing
- Just h -> liftIO $ Just <$>
- runReaderT (runWithHost getter) h
+ Just h -> do
+ (ret, _s, runlog) <- liftIO $
+ runRWST (runWithHost getter) h ()
+ tell runlog
+ return (Just ret)
onlyProcess :: FilePath -> IO a -> IO a
onlyProcess lockfile a = bracket lock unlock (const a)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 6ace5e4e..1533471e 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -7,7 +7,7 @@ import System.FilePath
import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
import Propellor.Types
import Propellor.Info
@@ -131,11 +131,11 @@ boolProperty desc a = property desc $ ifM (liftIO a)
revert :: RevertableProperty -> RevertableProperty
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
--- Changes the action that is performed to satisfy a property.
+-- | Changes the action that is performed to satisfy a property.
adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
--- Combines the Info of two properties.
+-- | Combines the Info of two properties.
combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
combineInfo p q = getInfo p <> getInfo q
@@ -147,3 +147,8 @@ makeChange a = liftIO a >> return MadeChange
noChange :: Propellor Result
noChange = return NoChange
+
+-- | Registers an action that should be run at the very end,
+-- and only when all configured Properties of the host succeed.
+endAction :: Desc -> Propellor Result -> Propellor ()
+endAction desc a = tell [EndAction desc a]
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 2f51b3e4..64cb5fbb 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -23,6 +23,8 @@ module Propellor.Types
, SshKeyType(..)
, Val(..)
, fromVal
+ , RunLog
+ , EndAction(..)
, module Propellor.Types.OS
, module Propellor.Types.Dns
) where
@@ -31,7 +33,7 @@ import Data.Monoid
import Control.Applicative
import System.Console.ANSI
import System.Posix.Types
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
import "MonadCatchIO-transformers" Control.Monad.CatchIO
import qualified Data.Set as S
import qualified Propellor.Types.Dns as Dns
@@ -52,13 +54,14 @@ data Host = Host
deriving (Show)
-- | Propellor's monad provides read-only access to info about the host
--- it's running on.
-newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
+-- it's running on, and a writer to accumulate logs about the run.
+newtype Propellor p = Propellor { runWithHost :: RWST Host RunLog () IO p }
deriving
( Monad
, Functor
, Applicative
, MonadReader Host
+ , MonadWriter RunLog
, MonadIO
, MonadCatchIO
)
@@ -197,3 +200,9 @@ instance Monoid (Val a) where
fromVal :: Val a -> Maybe a
fromVal (Val a) = Just a
fromVal NoVal = Nothing
+
+type RunLog = [EndAction]
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties.
+data EndAction = EndAction Desc (Propellor Result)