module Stackctl.Spec.Deploy
( DeployOptions (..)
, DeployConfirmation (..)
, parseDeployOptions
, runDeploy
) where
import Stackctl.Prelude
import Blammo.Logging.Logger (pushLoggerLn)
import qualified Data.Text as T
import Data.Time (defaultTimeLocale, formatTime, utcToLocalZonedTime)
import Options.Applicative
import Stackctl.AWS hiding (action)
import Stackctl.AWS.Scope
import Stackctl.Action
import Stackctl.Colors
import Stackctl.Config (HasConfig)
import Stackctl.DirectoryOption (HasDirectoryOption)
import Stackctl.FilterOption (HasFilterOption)
import Stackctl.ParameterOption
import Stackctl.Prompt
import Stackctl.RemovedStack
import Stackctl.Spec.Changes.Format
import Stackctl.Spec.Discover
import Stackctl.StackSpec
import Stackctl.TagOption
import UnliftIO.Directory (createDirectoryIfMissing)
data DeployOptions = DeployOptions
{ DeployOptions -> [Parameter]
sdoParameters :: [Parameter]
, DeployOptions -> [Tag]
sdoTags :: [Tag]
, DeployOptions -> Maybe FilePath
sdoSaveChangeSets :: Maybe FilePath
, DeployOptions -> DeployConfirmation
sdoDeployConfirmation :: DeployConfirmation
, DeployOptions -> Bool
sdoRemovals :: Bool
, DeployOptions -> Bool
sdoClean :: Bool
}
parseDeployOptions :: Parser DeployOptions
parseDeployOptions :: Parser DeployOptions
parseDeployOptions =
[Parameter]
-> [Tag]
-> Maybe FilePath
-> DeployConfirmation
-> Bool
-> Bool
-> DeployOptions
DeployOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Parameter
parameterOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Tag
tagOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"save-change-sets"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIRECTORY"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Save executed changesets to DIRECTORY"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"directory"
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag
DeployConfirmation
DeployWithConfirmation
DeployConfirmation
DeployWithoutConfirmation
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-confirm"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't confirm changes before executing"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Bool -> Bool
not
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-remove"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't delete removed Stacks"
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"clean"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Remove all changesets from Stack after deploy"
)
runDeploy
:: ( MonadMask m
, MonadUnliftIO m
, MonadResource m
, MonadLogger m
, MonadReader env m
, HasLogger env
, HasAwsScope env
, HasAwsEnv env
, HasConfig env
, HasDirectoryOption env
, HasFilterOption env
)
=> DeployOptions
-> m ()
runDeploy :: forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasLogger env, HasAwsScope env, HasAwsEnv env,
HasConfig env, HasDirectoryOption env, HasFilterOption env) =>
DeployOptions -> m ()
runDeploy DeployOptions {Bool
[Tag]
[Parameter]
Maybe FilePath
DeployConfirmation
sdoClean :: Bool
sdoRemovals :: Bool
sdoDeployConfirmation :: DeployConfirmation
sdoSaveChangeSets :: Maybe FilePath
sdoTags :: [Tag]
sdoParameters :: [Parameter]
sdoClean :: DeployOptions -> Bool
sdoRemovals :: DeployOptions -> Bool
sdoDeployConfirmation :: DeployOptions -> DeployConfirmation
sdoSaveChangeSets :: DeployOptions -> Maybe FilePath
sdoTags :: DeployOptions -> [Tag]
sdoParameters :: DeployOptions -> [Parameter]
..} = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sdoRemovals forall a b. (a -> b) -> a -> b
$ do
[Stack]
removed <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
HasAwsEnv env, HasAwsScope env, HasFilterOption env) =>
m [Stack]
inferRemovedStacks
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> Stack -> m ()
deleteRemovedStack DeployConfirmation
sdoDeployConfirmation) [Stack]
removed
forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
HasAwsScope env, HasConfig env, HasDirectoryOption env,
HasFilterOption env) =>
(StackSpec -> m ()) -> m ()
forEachSpec_ forall a b. (a -> b) -> a -> b
$ \StackSpec
spec -> do
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Key
"stackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackSpec -> StackName
stackSpecStackName StackSpec
spec] forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> StackName -> m ()
checkIfStackRequiresDeletion DeployConfirmation
sdoDeployConfirmation
forall a b. (a -> b) -> a -> b
$ StackSpec -> StackName
stackSpecStackName StackSpec
spec
Either Text (Maybe ChangeSet)
emChangeSet <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasAwsEnv env) =>
StackSpec
-> [Parameter] -> [Tag] -> m (Either Text (Maybe ChangeSet))
createChangeSet StackSpec
spec [Parameter]
sdoParameters [Tag]
sdoTags
case Either Text (Maybe ChangeSet)
emChangeSet of
Left Text
err -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"Error creating ChangeSet" Text -> [SeriesElem] -> Message
:# [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
err]
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
Right Maybe ChangeSet
Nothing -> forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Stack is up to date"
Right (Just ChangeSet
changeSet) -> do
let stackName :: StackName
stackName = StackSpec -> StackName
stackSpecStackName StackSpec
spec
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FilePath
sdoSaveChangeSets forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
let out :: FilePath
out = FilePath
dir FilePath -> FilePath -> FilePath
</> Text -> FilePath
unpack (StackName -> Text
unStackName StackName
stackName) FilePath -> FilePath -> FilePath
<.> FilePath
"json"
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Recording changeset" Text -> [SeriesElem] -> Message
:# [Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
out]
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
dir
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
out forall a b. (a -> b) -> a -> b
$ ChangeSet -> Text
changeSetJSON ChangeSet
changeSet
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> ChangeSet -> m ()
deployChangeSet DeployConfirmation
sdoDeployConfirmation ChangeSet
changeSet
forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m, HasLogger env,
HasAwsEnv env) =>
StackName -> ActionOn -> [Action] -> m ()
runActions StackName
stackName ActionOn
PostDeploy forall a b. (a -> b) -> a -> b
$ StackSpec -> [Action]
stackSpecActions StackSpec
spec
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sdoClean forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m ()
awsCloudFormationDeleteAllChangeSets StackName
stackName
deleteRemovedStack
:: ( MonadMask m
, MonadResource m
, MonadLogger m
, MonadReader env m
, HasLogger env
, HasAwsEnv env
)
=> DeployConfirmation
-> Stack
-> m ()
deleteRemovedStack :: forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> Stack -> m ()
deleteRemovedStack DeployConfirmation
confirmation Stack
stack = do
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Key
"stack" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackName
stackName] forall a b. (a -> b) -> a -> b
$ do
Colors
colors <- forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn forall a b. (a -> b) -> a -> b
$ Colors -> Format -> Stack -> Text
formatRemovedStack Colors
colors Format
FormatTTY Stack
stack
case DeployConfirmation
confirmation of
DeployConfirmation
DeployWithConfirmation -> do
forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
m ()
promptContinue
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Deleting Stack"
DeployConfirmation
DeployWithoutConfirmation -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m ()
deleteStack StackName
stackName
where
stackName :: StackName
stackName = Text -> StackName
StackName forall a b. (a -> b) -> a -> b
$ Stack
stack forall s a. s -> Getting a s a -> a
^. Lens' Stack Text
stack_stackName
data DeployConfirmation
= DeployWithConfirmation
| DeployWithoutConfirmation
deriving stock (DeployConfirmation -> DeployConfirmation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeployConfirmation -> DeployConfirmation -> Bool
$c/= :: DeployConfirmation -> DeployConfirmation -> Bool
== :: DeployConfirmation -> DeployConfirmation -> Bool
$c== :: DeployConfirmation -> DeployConfirmation -> Bool
Eq)
checkIfStackRequiresDeletion
:: ( MonadUnliftIO m
, MonadResource m
, MonadLogger m
, MonadReader env m
, HasLogger env
, HasAwsEnv env
)
=> DeployConfirmation
-> StackName
-> m ()
checkIfStackRequiresDeletion :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> StackName -> m ()
checkIfStackRequiresDeletion DeployConfirmation
confirmation StackName
stackName = do
Maybe Stack
mStack <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m (Maybe Stack)
awsCloudFormationDescribeStackMaybe StackName
stackName
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Stack -> Maybe StackStatus
stackStatusRequiresDeletion forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Stack
mStack) forall a b. (a -> b) -> a -> b
$ \StackStatus
status -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Text
"Stack must be deleted before proceeding" Text -> [SeriesElem] -> Message
:# [Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackStatus
status]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StackStatus
status forall a. Eq a => a -> a -> Bool
== StackStatus
StackStatus_ROLLBACK_FAILED)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn
Message
"Stack is in ROLLBACK_FAILED. This may require elevated permissions for the delete to succeed"
case DeployConfirmation
confirmation of
DeployConfirmation
DeployWithConfirmation -> forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
m ()
promptContinue
DeployConfirmation
DeployWithoutConfirmation -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError Message
"Refusing to delete without confirmation"
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Deleting Stack"
forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m ()
deleteStack StackName
stackName
deleteStack
:: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)
=> StackName
-> m ()
deleteStack :: forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m ()
deleteStack StackName
stackName = do
StackDeleteResult
result <- forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m StackDeleteResult
awsCloudFormationDeleteStack StackName
stackName
case StackDeleteResult
result of
StackDeleteResult
StackDeleteSuccess -> forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ StackDeleteResult -> Text
prettyStackDeleteResult StackDeleteResult
result Text -> [SeriesElem] -> Message
:# []
StackDeleteFailure {} -> forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ StackDeleteResult -> Text
prettyStackDeleteResult StackDeleteResult
result Text -> [SeriesElem] -> Message
:# []
deployChangeSet
:: ( MonadUnliftIO m
, MonadResource m
, MonadLogger m
, MonadReader env m
, HasLogger env
, HasAwsEnv env
)
=> DeployConfirmation
-> ChangeSet
-> m ()
deployChangeSet :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasLogger env, HasAwsEnv env) =>
DeployConfirmation -> ChangeSet -> m ()
deployChangeSet DeployConfirmation
confirmation ChangeSet
changeSet = do
Colors
colors <- forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn forall a b. (a -> b) -> a -> b
$ Colors -> Text -> Maybe ChangeSet -> Text
formatTTY Colors
colors (StackName -> Text
unStackName StackName
stackName) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ChangeSet
changeSet
case DeployConfirmation
confirmation of
DeployConfirmation
DeployWithConfirmation -> forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
m ()
promptContinue
DeployConfirmation
DeployWithoutConfirmation -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe Text
mLastId <- forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m (Maybe Text)
awsCloudFormationGetMostRecentStackEventId StackName
stackName
Async Any
asyncTail <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadLogger m, MonadReader env m, HasLogger env,
HasAwsEnv env) =>
StackName -> Maybe Text -> m a
tailStackEventsSince StackName
stackName Maybe Text
mLastId
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Executing ChangeSet" Text -> [SeriesElem] -> Message
:# [Key
"changeSetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChangeSetId
changeSetId]
StackDeployResult
result <- do
forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
ChangeSetId -> m ()
awsCloudFormationExecuteChangeSet ChangeSetId
changeSetId
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
HasAwsEnv env) =>
StackName -> m StackDeployResult
awsCloudFormationWait StackName
stackName
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async Any
asyncTail
let
onSuccess :: m ()
onSuccess = forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ StackDeployResult -> Text
prettyStackDeployResult StackDeployResult
result Text -> [SeriesElem] -> Message
:# []
onFailure :: m ()
onFailure = do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ StackDeployResult -> Text
prettyStackDeployResult StackDeployResult
result Text -> [SeriesElem] -> Message
:# []
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
case StackDeployResult
result of
StackDeployResult
StackCreateSuccess -> m ()
onSuccess
StackCreateFailure {} -> m ()
onFailure
StackDeployResult
StackUpdateSuccess -> m ()
onSuccess
StackUpdateFailure {} -> m ()
onFailure
where
stackName :: StackName
stackName = ChangeSet -> StackName
csStackName ChangeSet
changeSet
changeSetId :: ChangeSetId
changeSetId = ChangeSet -> ChangeSetId
csChangeSetId ChangeSet
changeSet
tailStackEventsSince
:: ( MonadResource m
, MonadLogger m
, MonadReader env m
, HasLogger env
, HasAwsEnv env
)
=> StackName
-> Maybe Text
-> m a
tailStackEventsSince :: forall (m :: * -> *) env a.
(MonadResource m, MonadLogger m, MonadReader env m, HasLogger env,
HasAwsEnv env) =>
StackName -> Maybe Text -> m a
tailStackEventsSince StackName
stackName Maybe Text
mLastId = do
Colors
colors <- forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger
[StackEvent]
events <- forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> Maybe Text -> m [StackEvent]
awsCloudFormationDescribeStackEvents StackName
stackName Maybe Text
mLastId
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Text -> m ()
pushLoggerLn forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). MonadIO m => Colors -> StackEvent -> m Text
formatStackEvent Colors
colors) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [StackEvent]
events
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
* Int
1000000
forall (m :: * -> *) env a.
(MonadResource m, MonadLogger m, MonadReader env m, HasLogger env,
HasAwsEnv env) =>
StackName -> Maybe Text -> m a
tailStackEventsSince StackName
stackName forall a b. (a -> b) -> a -> b
$ [StackEvent] -> Maybe Text
getLastEventId [StackEvent]
events forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
mLastId
formatStackEvent :: MonadIO m => Colors -> StackEvent -> m Text
formatStackEvent :: forall (m :: * -> *). MonadIO m => Colors -> StackEvent -> m Text
formatStackEvent Colors {Text -> Text
gray :: Colors -> Text -> Text
black :: Colors -> Text -> Text
cyan :: Colors -> Text -> Text
magenta :: Colors -> Text -> Text
blue :: Colors -> Text -> Text
yellow :: Colors -> Text -> Text
green :: Colors -> Text -> Text
red :: Colors -> Text -> Text
bold :: Colors -> Text -> Text
dim :: Colors -> Text -> Text
dim :: Text -> Text
bold :: Text -> Text
red :: Text -> Text
green :: Text -> Text
yellow :: Text -> Text
blue :: Text -> Text
magenta :: Text -> Text
cyan :: Text -> Text
black :: Text -> Text
gray :: Text -> Text
..} StackEvent
e = do
FilePath
timestamp <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%F %T %Z"
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> IO ZonedTime
utcToLocalZonedTime
(StackEvent
e forall s a. s -> Getting a s a -> a
^. Lens' StackEvent UTCTime
stackEvent_timestamp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ forall a. IsString a => FilePath -> a
fromString FilePath
timestamp
, Text
" | "
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ResourceStatus -> Text
colorStatus forall a b. (a -> b) -> a -> b
$ StackEvent
e forall s a. s -> Getting a s a -> a
^. Lens' StackEvent (Maybe ResourceStatus)
stackEvent_resourceStatus
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text
magenta forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " forall a. Semigroup a => a -> a -> a
<>)) forall a b. (a -> b) -> a -> b
$ StackEvent
e forall s a. s -> Getting a s a -> a
^. Lens' StackEvent (Maybe Text)
stackEvent_logicalResourceId
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((\Text
x -> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
")") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip)
forall a b. (a -> b) -> a -> b
$ StackEvent
e
forall s a. s -> Getting a s a -> a
^. Lens' StackEvent (Maybe Text)
stackEvent_resourceStatusReason
]
where
colorStatus :: ResourceStatus -> Text
colorStatus = \case
ResourceStatus' Text
x
| Text
"ROLLBACK" Text -> Text -> Bool
`T.isInfixOf` Text
x -> Text -> Text
red Text
x
| Text
"COMPLETE" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> Text
green Text
x
| Text
"FAILED" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> Text
red Text
x
| Text
"IN_PROGRESS" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> Text
blue Text
x
| Text
"SKIPPED" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> Text
yellow Text
x
| Bool
otherwise -> Text
x
getLastEventId :: [StackEvent] -> Maybe Text
getLastEventId :: [StackEvent] -> Maybe Text
getLastEventId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. Lens' StackEvent Text
stackEvent_eventId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe