propellor/src/Propellor/Engine.hs

52 lines
1.4 KiB
Haskell
Raw Normal View History

{-# LANGUAGE PackageImports #-}
2014-03-31 05:06:44 +00:00
module Propellor.Engine where
import System.Exit
import System.IO
2014-03-31 14:36:45 +00:00
import Data.Monoid
import Control.Applicative
2014-03-31 22:31:08 +00:00
import System.Console.ANSI
import "mtl" Control.Monad.Reader
2014-03-31 05:06:44 +00:00
import Propellor.Types
2014-03-31 22:31:08 +00:00
import Propellor.Message
import Propellor.Exception
2014-06-09 05:45:58 +00:00
import Propellor.Info
2014-03-31 05:06:44 +00:00
runPropellor :: Host -> Propellor a -> IO a
runPropellor host a = runReaderT (runWithHost a) host
2014-03-31 05:06:44 +00:00
mainProperties :: Host -> IO ()
mainProperties host = do
r <- runPropellor host $
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
2014-03-31 23:31:35 +00:00
setTitle "propellor: done"
2014-03-31 05:19:40 +00:00
hFlush stdout
2014-03-31 05:06:44 +00:00
case r of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
ensureProperties :: [Property] -> Propellor Result
ensureProperties ps = ensure ps NoChange
2014-03-31 05:06:44 +00:00
where
ensure [] rs = return rs
ensure (l:ls) rs = do
2014-06-01 00:48:23 +00:00
hn <- asks hostName
2014-05-31 22:52:42 +00:00
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
2014-03-31 14:36:45 +00:00
ensure ls (r <> rs)
ensureProperty :: Property -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
-- | Lifts an action into a different host.
--
-- For example, `fromHost hosts "otherhost" getSshPubKey`
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of
2014-07-23 16:27:38 +00:00
Nothing -> return Nothing
Just h -> liftIO $ do
print ("fromHost", hn, "using", h)
Just <$>
runReaderT (runWithHost getter) h