propellor/src/Propellor/Engine.hs

130 lines
3.8 KiB
Haskell
Raw Permalink Normal View History

{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GADTs #-}
module Propellor.Engine (
mainProperties,
runPropellor,
ensureProperty,
ensureProperties,
fromHost,
onlyProcess,
processChainOutput,
) where
2014-03-31 05:06:44 +00:00
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.RWS.Strict
import System.PosixCompat
import System.Posix.IO
2014-11-23 02:24:09 +00:00
import System.FilePath
import System.Directory
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
import Utility.Exception
2014-11-20 19:15:28 +00:00
import Utility.PartialPrelude
import Utility.Monad
2014-03-31 05:06:44 +00:00
-- | Gets the Properties of a Host, and ensures them all,
-- with nice display of what's being done.
mainProperties :: Host -> IO ()
mainProperties host = do
ret <- runPropellor host $
ensureProperties [ignoreInfo $ infoProperty "overall" (ensureProperties ps) mempty mempty]
h <- mkMessageHandle
whenConsole h $
setTitle "propellor: done"
2014-03-31 05:19:40 +00:00
hFlush stdout
case ret of
2014-03-31 05:06:44 +00:00
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
where
moving to using the GADT The problem this exposes has to do with requires. As implemented, requires yields either a Property HasInfo or a Property NoInfo depending on its inputs. That works. But look what happens when it's used: *Propellor.Types> let foo = IProperty "foo" (return NoChange) mempty mempty *Propellor.Types> let bar = IProperty "bar" (return NoChange) mempty mempty *Propellor.Types> foo `requires` bar <interactive>:17:5: No instance for (Requires (Property HasInfo) (Property HasInfo) r0) arising from a use of `requires' The type variable `r0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) r0) In the expression: foo `requires` bar In an equation for `it': it = foo `requires` bar This can be avoided by specifying the result type: *Propellor.Types> (foo `requires` bar) :: Property HasInfo property "foo" But then when multiple `requires` are given, the result type has to be given each time: *Propellor.Types> (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:6: No instance for (Requires (Property HasInfo) (Property HasInfo) x0) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) x0) In the first argument of `requires', namely `foo `requires` bar' In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:21: No instance for (Requires x0 (Property HasInfo) (Property HasInfo)) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there are several potential instances: instance Requires (Property NoInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:175:10 instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires x0 (Property HasInfo) (Property HasInfo)) In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo *Propellor.Types> (((foo `requires` bar) :: Property HasInfo) `requires` bar) :: Property HasInfo property "foo" Yuggh!
2015-01-24 20:54:49 +00:00
ps = map ignoreInfo $ hostProperties host
2014-03-31 05:06:44 +00:00
-- | 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
2014-12-06 17:21:19 +00:00
(res, _s, endactions) <- runRWST (runWithHost a) host ()
endres <- mapM (runEndAction host res) endactions
return $ mconcat (res:endres)
2014-12-06 17:21:19 +00:00
runEndAction :: Host -> Result -> EndAction -> IO Result
runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc $ do
(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
return ret
2014-12-07 20:37:02 +00:00
-- | For when code running in the Propellor monad needs to ensure a
-- Property.
--
moving to using the GADT The problem this exposes has to do with requires. As implemented, requires yields either a Property HasInfo or a Property NoInfo depending on its inputs. That works. But look what happens when it's used: *Propellor.Types> let foo = IProperty "foo" (return NoChange) mempty mempty *Propellor.Types> let bar = IProperty "bar" (return NoChange) mempty mempty *Propellor.Types> foo `requires` bar <interactive>:17:5: No instance for (Requires (Property HasInfo) (Property HasInfo) r0) arising from a use of `requires' The type variable `r0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) r0) In the expression: foo `requires` bar In an equation for `it': it = foo `requires` bar This can be avoided by specifying the result type: *Propellor.Types> (foo `requires` bar) :: Property HasInfo property "foo" But then when multiple `requires` are given, the result type has to be given each time: *Propellor.Types> (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:6: No instance for (Requires (Property HasInfo) (Property HasInfo) x0) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) x0) In the first argument of `requires', namely `foo `requires` bar' In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:21: No instance for (Requires x0 (Property HasInfo) (Property HasInfo)) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there are several potential instances: instance Requires (Property NoInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:175:10 instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires x0 (Property HasInfo) (Property HasInfo)) In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo *Propellor.Types> (((foo `requires` bar) :: Property HasInfo) `requires` bar) :: Property HasInfo property "foo" Yuggh!
2015-01-24 20:54:49 +00:00
-- This can only be used on a Property that has NoInfo.
ensureProperty :: Property NoInfo -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
2014-12-07 20:37:02 +00:00
-- | Ensures a list of Properties, with a display of each as it runs.
moving to using the GADT The problem this exposes has to do with requires. As implemented, requires yields either a Property HasInfo or a Property NoInfo depending on its inputs. That works. But look what happens when it's used: *Propellor.Types> let foo = IProperty "foo" (return NoChange) mempty mempty *Propellor.Types> let bar = IProperty "bar" (return NoChange) mempty mempty *Propellor.Types> foo `requires` bar <interactive>:17:5: No instance for (Requires (Property HasInfo) (Property HasInfo) r0) arising from a use of `requires' The type variable `r0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) r0) In the expression: foo `requires` bar In an equation for `it': it = foo `requires` bar This can be avoided by specifying the result type: *Propellor.Types> (foo `requires` bar) :: Property HasInfo property "foo" But then when multiple `requires` are given, the result type has to be given each time: *Propellor.Types> (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:6: No instance for (Requires (Property HasInfo) (Property HasInfo) x0) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there is a potential instance available: instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires (Property HasInfo) (Property HasInfo) x0) In the first argument of `requires', namely `foo `requires` bar' In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo <interactive>:22:21: No instance for (Requires x0 (Property HasInfo) (Property HasInfo)) arising from a use of `requires' The type variable `x0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there are several potential instances: instance Requires (Property NoInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:175:10 instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) -- Defined at Propellor/Types.hs:167:10 Possible fix: add an instance declaration for (Requires x0 (Property HasInfo) (Property HasInfo)) In the expression: (foo `requires` bar `requires` bar) :: Property HasInfo In an equation for `it': it = (foo `requires` bar `requires` bar) :: Property HasInfo *Propellor.Types> (((foo `requires` bar) :: Property HasInfo) `requires` bar) :: Property HasInfo property "foo" Yuggh!
2015-01-24 20:54:49 +00:00
ensureProperties :: [Property NoInfo] -> Propellor Result
ensureProperties ps = ensure ps NoChange
2014-03-31 05:06:44 +00:00
where
ensure [] rs = return rs
ensure (p:ls) rs = do
2014-06-01 00:48:23 +00:00
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
2014-03-31 14:36:45 +00:00
ensure ls (r <> rs)
-- | Lifts an action into a different host.
--
-- > fromHost hosts "otherhost" getPubKey
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 -> 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)
where
lock = do
2014-11-23 02:24:09 +00:00
createDirectoryIfMissing True (takeDirectory lockfile)
l <- createFile lockfile stdFileMode
setLock l (WriteLock, AbsoluteSeek, 0, 0)
`catchIO` const alreadyrunning
return l
unlock = closeFd
alreadyrunning = error "Propellor is already running on this host!"
2014-11-20 19:15:28 +00:00
-- | Reads and displays each line from the Handle, except for the last line
-- which is a Result.
processChainOutput :: Handle -> IO Result
processChainOutput h = go Nothing
where
go lastline = do
v <- catchMaybeIO (hGetLine h)
2014-11-27 21:51:41 +00:00
debug ["read from chained propellor: ", show v]
2014-11-20 19:15:28 +00:00
case v of
Nothing -> case lastline of
2014-11-27 21:55:56 +00:00
Nothing -> do
debug ["chained propellor output nothing; assuming it failed"]
return FailedChange
Just l -> case readish l of
Just r -> pure r
Nothing -> do
2014-11-27 21:55:56 +00:00
debug ["chained propellor output did not end with a Result; assuming it failed"]
putStrLn l
hFlush stdout
return FailedChange
2014-11-20 19:15:28 +00:00
Just s -> do
2014-11-20 20:07:57 +00:00
maybe noop (\l -> unless (null l) (putStrLn l)) lastline
2014-11-20 19:15:28 +00:00
hFlush stdout
go (Just s)