module Stackctl.AWS.CloudFormation
  ( Stack (..)
  , stack_stackName
  , stackDescription
  , stackStatusRequiresDeletion
  , StackId (..)
  , StackName (..)
  , StackDescription (..)
  , StackStatus (..)
  , StackEvent (..)
  , ResourceStatus (..)
  , stackEvent_eventId
  , stackEvent_logicalResourceId
  , stackEvent_resourceStatus
  , stackEvent_resourceStatusReason
  , stackEvent_timestamp
  , StackTemplate (..)
  , StackDeployResult (..)
  , prettyStackDeployResult
  , StackDeleteResult (..)
  , prettyStackDeleteResult
  , Parameter
  , parameter_parameterKey
  , parameter_parameterValue
  , newParameter
  , makeParameter
  , readParameter
  , Capability (..)
  , Tag
  , newTag
  , tag_key
  , tag_value
  , Output
  , output_outputKey
  , output_outputValue
  , awsCloudFormationDescribeStack
  , awsCloudFormationDescribeStackMaybe
  , awsCloudFormationDescribeStackOutputs
  , awsCloudFormationDescribeStackEvents
  , awsCloudFormationGetStackNamesMatching
  , awsCloudFormationGetMostRecentStackEventId
  , awsCloudFormationDeleteStack
  , awsCloudFormationWait
  , awsCloudFormationGetTemplate

    -- * ChangeSets
  , ChangeSet (..)
  , changeSetJSON
  , ChangeSetId (..)
  , ChangeSetName (..)
  , Change (..)
  , ResourceChange (..)
  , Replacement (..)
  , ChangeAction (..)
  , ResourceAttribute (..)
  , ResourceChangeDetail (..)
  , ChangeSource (..)
  , ResourceTargetDefinition (..)
  , RequiresRecreation (..)
  , awsCloudFormationCreateChangeSet
  , awsCloudFormationExecuteChangeSet
  , awsCloudFormationDeleteAllChangeSets
  ) where

import Stackctl.Prelude

import Amazonka.CloudFormation.CreateChangeSet hiding (id)
import Amazonka.CloudFormation.DeleteChangeSet
import Amazonka.CloudFormation.DeleteStack
import Amazonka.CloudFormation.DescribeChangeSet
import Amazonka.CloudFormation.DescribeStackEvents
import Amazonka.CloudFormation.DescribeStacks
import Amazonka.CloudFormation.ExecuteChangeSet
import Amazonka.CloudFormation.GetTemplate
import Amazonka.CloudFormation.ListChangeSets
import Amazonka.CloudFormation.ListStacks
import Amazonka.CloudFormation.Types
import qualified Amazonka.CloudFormation.Types.ChangeSetSummary as Summary
import Amazonka.CloudFormation.Waiters
import Amazonka.Core
  ( AsError
  , ServiceError
  , hasStatus
  , _MatchServiceError
  , _ServiceError
  )
import Amazonka.Waiter (Accept (..))
import Conduit
import Control.Lens ((?~))
import Data.Aeson
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy as BSL
import Data.Monoid (First)
import qualified Data.Text as T
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import Stackctl.AWS.Core
import Stackctl.Sort
import Stackctl.StackDescription
import System.FilePath.Glob
import UnliftIO.Exception.Lens (handling_, trying)

stackDescription :: Stack -> Maybe StackDescription
stackDescription :: Stack -> Maybe StackDescription
stackDescription = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StackDescription
StackDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Stack (Maybe Text)
stack_description)

newtype StackId = StackId
  { StackId -> Text
unStackId :: Text
  }
  deriving newtype (StackId -> StackId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackId -> StackId -> Bool
$c/= :: StackId -> StackId -> Bool
== :: StackId -> StackId -> Bool
$c== :: StackId -> StackId -> Bool
Eq, Eq StackId
StackId -> StackId -> Bool
StackId -> StackId -> Ordering
StackId -> StackId -> StackId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StackId -> StackId -> StackId
$cmin :: StackId -> StackId -> StackId
max :: StackId -> StackId -> StackId
$cmax :: StackId -> StackId -> StackId
>= :: StackId -> StackId -> Bool
$c>= :: StackId -> StackId -> Bool
> :: StackId -> StackId -> Bool
$c> :: StackId -> StackId -> Bool
<= :: StackId -> StackId -> Bool
$c<= :: StackId -> StackId -> Bool
< :: StackId -> StackId -> Bool
$c< :: StackId -> StackId -> Bool
compare :: StackId -> StackId -> Ordering
$ccompare :: StackId -> StackId -> Ordering
Ord, Int -> StackId -> ShowS
[StackId] -> ShowS
StackId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackId] -> ShowS
$cshowList :: [StackId] -> ShowS
show :: StackId -> String
$cshow :: StackId -> String
showsPrec :: Int -> StackId -> ShowS
$cshowsPrec :: Int -> StackId -> ShowS
Show, Value -> Parser [StackId]
Value -> Parser StackId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StackId]
$cparseJSONList :: Value -> Parser [StackId]
parseJSON :: Value -> Parser StackId
$cparseJSON :: Value -> Parser StackId
FromJSON, [StackId] -> Encoding
[StackId] -> Value
StackId -> Encoding
StackId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StackId] -> Encoding
$ctoEncodingList :: [StackId] -> Encoding
toJSONList :: [StackId] -> Value
$ctoJSONList :: [StackId] -> Value
toEncoding :: StackId -> Encoding
$ctoEncoding :: StackId -> Encoding
toJSON :: StackId -> Value
$ctoJSON :: StackId -> Value
ToJSON)

newtype StackName = StackName
  { StackName -> Text
unStackName :: Text
  }
  deriving newtype (StackName -> StackName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackName -> StackName -> Bool
$c/= :: StackName -> StackName -> Bool
== :: StackName -> StackName -> Bool
$c== :: StackName -> StackName -> Bool
Eq, Eq StackName
StackName -> StackName -> Bool
StackName -> StackName -> Ordering
StackName -> StackName -> StackName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StackName -> StackName -> StackName
$cmin :: StackName -> StackName -> StackName
max :: StackName -> StackName -> StackName
$cmax :: StackName -> StackName -> StackName
>= :: StackName -> StackName -> Bool
$c>= :: StackName -> StackName -> Bool
> :: StackName -> StackName -> Bool
$c> :: StackName -> StackName -> Bool
<= :: StackName -> StackName -> Bool
$c<= :: StackName -> StackName -> Bool
< :: StackName -> StackName -> Bool
$c< :: StackName -> StackName -> Bool
compare :: StackName -> StackName -> Ordering
$ccompare :: StackName -> StackName -> Ordering
Ord, Int -> StackName -> ShowS
[StackName] -> ShowS
StackName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackName] -> ShowS
$cshowList :: [StackName] -> ShowS
show :: StackName -> String
$cshow :: StackName -> String
showsPrec :: Int -> StackName -> ShowS
$cshowsPrec :: Int -> StackName -> ShowS
Show, Value -> Parser [StackName]
Value -> Parser StackName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StackName]
$cparseJSONList :: Value -> Parser [StackName]
parseJSON :: Value -> Parser StackName
$cparseJSON :: Value -> Parser StackName
FromJSON, [StackName] -> Encoding
[StackName] -> Value
StackName -> Encoding
StackName -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StackName] -> Encoding
$ctoEncodingList :: [StackName] -> Encoding
toJSONList :: [StackName] -> Value
$ctoJSONList :: [StackName] -> Value
toEncoding :: StackName -> Encoding
$ctoEncoding :: StackName -> Encoding
toJSON :: StackName -> Value
$ctoJSON :: StackName -> Value
ToJSON)

newtype StackTemplate = StackTemplate
  { StackTemplate -> String
unStackTemplate :: FilePath
  }
  deriving stock (StackTemplate -> StackTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTemplate -> StackTemplate -> Bool
$c/= :: StackTemplate -> StackTemplate -> Bool
== :: StackTemplate -> StackTemplate -> Bool
$c== :: StackTemplate -> StackTemplate -> Bool
Eq, Int -> StackTemplate -> ShowS
[StackTemplate] -> ShowS
StackTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTemplate] -> ShowS
$cshowList :: [StackTemplate] -> ShowS
show :: StackTemplate -> String
$cshow :: StackTemplate -> String
showsPrec :: Int -> StackTemplate -> ShowS
$cshowsPrec :: Int -> StackTemplate -> ShowS
Show)
  deriving newtype (Value -> Parser [StackTemplate]
Value -> Parser StackTemplate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StackTemplate]
$cparseJSONList :: Value -> Parser [StackTemplate]
parseJSON :: Value -> Parser StackTemplate
$cparseJSON :: Value -> Parser StackTemplate
FromJSON, [StackTemplate] -> Encoding
[StackTemplate] -> Value
StackTemplate -> Encoding
StackTemplate -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StackTemplate] -> Encoding
$ctoEncodingList :: [StackTemplate] -> Encoding
toJSONList :: [StackTemplate] -> Value
$ctoJSONList :: [StackTemplate] -> Value
toEncoding :: StackTemplate -> Encoding
$ctoEncoding :: StackTemplate -> Encoding
toJSON :: StackTemplate -> Value
$ctoJSON :: StackTemplate -> Value
ToJSON)

data StackDeployResult
  = StackCreateSuccess
  | StackCreateFailure Bool
  | StackUpdateSuccess
  | StackUpdateFailure Bool
  deriving stock (Int -> StackDeployResult -> ShowS
[StackDeployResult] -> ShowS
StackDeployResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackDeployResult] -> ShowS
$cshowList :: [StackDeployResult] -> ShowS
show :: StackDeployResult -> String
$cshow :: StackDeployResult -> String
showsPrec :: Int -> StackDeployResult -> ShowS
$cshowsPrec :: Int -> StackDeployResult -> ShowS
Show)

prettyStackDeployResult :: StackDeployResult -> Text
prettyStackDeployResult :: StackDeployResult -> Text
prettyStackDeployResult = \case
  StackDeployResult
StackCreateSuccess -> Text
"Created Stack successfully"
  StackCreateFailure {} -> Text
"Failed to create Stack"
  StackDeployResult
StackUpdateSuccess -> Text
"Updated Stack successfully"
  StackUpdateFailure {} -> Text
"Failed to update Stack"

stackCreateResult :: Accept -> StackDeployResult
stackCreateResult :: Accept -> StackDeployResult
stackCreateResult = \case
  Accept
AcceptSuccess -> StackDeployResult
StackCreateSuccess
  Accept
AcceptFailure -> Bool -> StackDeployResult
StackCreateFailure Bool
False
  Accept
AcceptRetry -> Bool -> StackDeployResult
StackCreateFailure Bool
True

stackUpdateResult :: Accept -> StackDeployResult
stackUpdateResult :: Accept -> StackDeployResult
stackUpdateResult = \case
  Accept
AcceptSuccess -> StackDeployResult
StackUpdateSuccess
  Accept
AcceptFailure -> Bool -> StackDeployResult
StackUpdateFailure Bool
False
  Accept
AcceptRetry -> Bool -> StackDeployResult
StackUpdateFailure Bool
True

data StackDeleteResult
  = StackDeleteSuccess
  | StackDeleteFailure Bool

prettyStackDeleteResult :: StackDeleteResult -> Text
prettyStackDeleteResult :: StackDeleteResult -> Text
prettyStackDeleteResult = \case
  StackDeleteResult
StackDeleteSuccess -> Text
"Deleted Stack successfully"
  StackDeleteFailure {} -> Text
"Failed to delete Stack"

stackDeleteResult :: Accept -> StackDeleteResult
stackDeleteResult :: Accept -> StackDeleteResult
stackDeleteResult = \case
  Accept
AcceptSuccess -> StackDeleteResult
StackDeleteSuccess
  Accept
AcceptFailure -> Bool -> StackDeleteResult
StackDeleteFailure Bool
False
  Accept
AcceptRetry -> Bool -> StackDeleteResult
StackDeleteFailure Bool
True

-- | @stackctl-{timestamp}-{uuid}@
newChangeSetName :: MonadIO m => m ChangeSetName
newChangeSetName :: forall (m :: * -> *). MonadIO m => m ChangeSetName
newChangeSetName = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  String
timestamp <- forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d%H%M" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  String
uuid <- UUID -> String
UUID.toString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom
  let parts :: [String]
parts = [String
"stackctl", String
timestamp, String
uuid]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ChangeSetName
ChangeSetName forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"-" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Text
pack [String]
parts

awsCloudFormationDescribeStack
  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName -> m Stack
awsCloudFormationDescribeStack :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m Stack
awsCloudFormationDescribeStack StackName
stackName = do
  let req :: DescribeStacks
req = DescribeStacks
newDescribeStacks forall a b. a -> (a -> b) -> b
& Lens' DescribeStacks (Maybe Text)
describeStacks_stackName forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName

  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"DescribeStack" DescribeStacks
req forall a b. (a -> b) -> a -> b
$ \AWSResponse DescribeStacks
resp -> do
    [Stack]
stacks <- AWSResponse DescribeStacks
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeStacksResponse (Maybe [Stack])
describeStacksResponse_stacks
    forall a. [a] -> Maybe a
listToMaybe [Stack]
stacks

awsCloudFormationDescribeStackMaybe
  :: (MonadUnliftIO m, MonadResource m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m (Maybe Stack)
awsCloudFormationDescribeStackMaybe :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m (Maybe Stack)
awsCloudFormationDescribeStackMaybe StackName
stackName =
  -- AWS gives us a 400 if the stackName doesn't exist, rather than simply
  -- returning an empty list, so we need to do this through exceptions
  forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ forall a. AsError a => Getting (First ServiceError) a ServiceError
_ValidationError (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
    forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m Stack
awsCloudFormationDescribeStack StackName
stackName

awsCloudFormationDescribeStackOutputs
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m [Output]
awsCloudFormationDescribeStackOutputs :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m [Output]
awsCloudFormationDescribeStackOutputs StackName
stackName = do
  Stack
stack <- forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m Stack
awsCloudFormationDescribeStack StackName
stackName
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ Stack -> Maybe [Output]
outputs Stack
stack

awsCloudFormationDescribeStackEvents
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> Maybe Text
  -- ^ Last-seen Id
  -> m [StackEvent]
awsCloudFormationDescribeStackEvents :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> Maybe Text -> m [StackEvent]
awsCloudFormationDescribeStackEvents StackName
stackName Maybe Text
mLastId = do
  let req :: DescribeStackEvents
req =
        DescribeStackEvents
newDescribeStackEvents
          forall a b. a -> (a -> b) -> b
& Lens' DescribeStackEvents (Maybe Text)
describeStackEvents_stackName
          forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName

  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> ConduitM () (AWSResponse a) m ()
awsPaginate DescribeStackEvents
req
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' DescribeStackEventsResponse (Maybe [StackEvent])
describeStackEventsResponse_stackEvents))
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) mono.
(Monad m, MonoFoldable mono) =>
ConduitT mono (Element mono) m ()
concatC
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
takeWhileC (\StackEvent
e -> forall a. a -> Maybe a
Just (StackEvent
e forall s a. s -> Getting a s a -> a
^. Lens' StackEvent Text
stackEvent_eventId) forall a. Eq a => a -> a -> Bool
/= Maybe Text
mLastId)
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

awsCloudFormationGetStackNamesMatching
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => Pattern
  -> m [StackName]
awsCloudFormationGetStackNamesMatching :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
Pattern -> m [StackName]
awsCloudFormationGetStackNamesMatching Pattern
p = do
  let req :: ListStacks
req = ListStacks
newListStacks forall a b. a -> (a -> b) -> b
& Lens' ListStacks (Maybe [StackStatus])
listStacks_stackStatusFilter forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [StackStatus]
runningStatuses

  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> ConduitM () (AWSResponse a) m ()
awsPaginate ListStacks
req
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> mono) -> ConduitT a (Element mono) m ()
concatMapC (forall s a. s -> Getting a s a -> a
^. Lens' ListStacksResponse (Maybe [StackSummary])
listStacksResponse_stackSummaries)
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) mono.
(Monad m, MonoFoldable mono) =>
ConduitT mono (Element mono) m ()
concatC
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall s a. s -> Getting a s a -> a
^. Lens' StackSummary Text
stackSummary_stackName)
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
filterC ((Pattern
p Pattern -> String -> Bool
`match`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack)
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC Text -> StackName
StackName
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

awsCloudFormationGetMostRecentStackEventId
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m (Maybe Text)
awsCloudFormationGetMostRecentStackEventId :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m (Maybe Text)
awsCloudFormationGetMostRecentStackEventId StackName
stackName = do
  let
    req :: DescribeStackEvents
req =
      DescribeStackEvents
newDescribeStackEvents
        forall a b. a -> (a -> b) -> b
& Lens' DescribeStackEvents (Maybe Text)
describeStackEvents_stackName
        forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName

    -- Events are returned most-recent first, so "last" is "first" here
    getFirstEventId :: [StackEvent] -> Maybe Text
    getFirstEventId :: [StackEvent] -> Maybe Text
getFirstEventId = \case
      [] -> forall a. Maybe a
Nothing
      (StackEvent
e : [StackEvent]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StackEvent
e forall s a. s -> Getting a s a -> a
^. Lens' StackEvent Text
stackEvent_eventId

  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"DescribeStackEvents" DescribeStackEvents
req
    forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StackEvent] -> Maybe Text
getFirstEventId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe []
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' DescribeStackEventsResponse (Maybe [StackEvent])
describeStackEventsResponse_stackEvents)

awsCloudFormationDeleteStack
  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m StackDeleteResult
awsCloudFormationDeleteStack :: forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m StackDeleteResult
awsCloudFormationDeleteStack StackName
stackName = do
  let
    deleteReq :: DeleteStack
deleteReq = Text -> DeleteStack
newDeleteStack forall a b. (a -> b) -> a -> b
$ StackName -> Text
unStackName StackName
stackName
    describeReq :: DescribeStacks
describeReq =
      DescribeStacks
newDescribeStacks forall a b. a -> (a -> b) -> b
& Lens' DescribeStacks (Maybe Text)
describeStacks_stackName forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName

  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"DeleteStack" DeleteStack
deleteReq forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug Message
"Awaiting DeleteStack"
  Accept -> StackDeleteResult
stackDeleteResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a) =>
Wait a -> a -> m Accept
awsAwait Wait DescribeStacks
newStackDeleteComplete DescribeStacks
describeReq

awsCloudFormationWait
  :: (MonadUnliftIO m, MonadResource m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m StackDeployResult
awsCloudFormationWait :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m StackDeployResult
awsCloudFormationWait StackName
stackName = do
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Accept -> StackDeployResult
stackCreateResult Accept -> StackDeployResult
stackUpdateResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race
      (forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a) =>
Wait a -> a -> m Accept
awsAwait Wait DescribeStacks
newStackCreateComplete DescribeStacks
req)
      (forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a) =>
Wait a -> a -> m Accept
awsAwait Wait DescribeStacks
newStackUpdateComplete DescribeStacks
req)
 where
  req :: DescribeStacks
req = DescribeStacks
newDescribeStacks forall a b. a -> (a -> b) -> b
& Lens' DescribeStacks (Maybe Text)
describeStacks_stackName forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName

awsCloudFormationGetTemplate
  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName -> m Value
awsCloudFormationGetTemplate :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m Value
awsCloudFormationGetTemplate StackName
stackName = do
  let
    req :: GetTemplate
req =
      GetTemplate
newGetTemplate
        forall a b. a -> (a -> b) -> b
& (Lens' GetTemplate (Maybe Text)
getTemplate_stackName forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StackName -> Text
unStackName StackName
stackName)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' GetTemplate (Maybe TemplateStage)
getTemplate_templateStage forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TemplateStage
TemplateStage_Original)

    -- If decodeStrict fails, assume it's a String of Yaml. See writeStackSpec.
    decodeTemplateBody :: Text -> Value
decodeTemplateBody Text
body =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. ToJSON a => a -> Value
toJSON Text
body) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
decodeStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
body

  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"GetTemplate" GetTemplate
req forall a b. (a -> b) -> a -> b
$ \AWSResponse GetTemplate
resp -> do
    Text
body <- AWSResponse GetTemplate
resp forall s a. s -> Getting a s a -> a
^. Lens' GetTemplateResponse (Maybe Text)
getTemplateResponse_templateBody
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Value
decodeTemplateBody Text
body

makeParameter :: Text -> Maybe Text -> Parameter
makeParameter :: Text -> Maybe Text -> Parameter
makeParameter Text
k Maybe Text
v =
  Parameter
newParameter forall a b. a -> (a -> b) -> b
& (Lens' Parameter (Maybe Text)
parameter_parameterKey forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' Parameter (Maybe Text)
parameter_parameterValue forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
v)

readParameter :: String -> Either String Parameter
readParameter :: String -> Either String Parameter
readParameter String
x = case Text -> Text -> (Text, Text)
T.breakOn Text
"=" forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
x of
  (Text
key, Text
_) | Text -> Bool
T.null Text
key -> forall {a} {b}. (Semigroup a, IsString a) => a -> Either a b
invalid String
"empty KEY"
  (Text
_, Text
value) | Text -> Bool
T.null Text
value -> forall {a} {b}. (Semigroup a, IsString a) => a -> Either a b
invalid String
"empty VALUE"
  (Text
_, Text
"=") -> forall {a} {b}. (Semigroup a, IsString a) => a -> Either a b
invalid String
"empty VALUE" -- Is supporting { k, Nothing } valuable?
  (Text
pName, Text
value) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Parameter
makeParameter Text
pName forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
value
 where
  invalid :: a -> Either a b
invalid a
msg = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ a
"Invalid format for parameter (KEY=VALUE): " forall a. Semigroup a => a -> a -> a
<> a
msg

newtype ChangeSetId = ChangeSetId
  { ChangeSetId -> Text
unChangeSetId :: Text
  }
  deriving newtype (Value -> Parser [ChangeSetId]
Value -> Parser ChangeSetId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChangeSetId]
$cparseJSONList :: Value -> Parser [ChangeSetId]
parseJSON :: Value -> Parser ChangeSetId
$cparseJSON :: Value -> Parser ChangeSetId
FromJSON, [ChangeSetId] -> Encoding
[ChangeSetId] -> Value
ChangeSetId -> Encoding
ChangeSetId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChangeSetId] -> Encoding
$ctoEncodingList :: [ChangeSetId] -> Encoding
toJSONList :: [ChangeSetId] -> Value
$ctoJSONList :: [ChangeSetId] -> Value
toEncoding :: ChangeSetId -> Encoding
$ctoEncoding :: ChangeSetId -> Encoding
toJSON :: ChangeSetId -> Value
$ctoJSON :: ChangeSetId -> Value
ToJSON)

newtype ChangeSetName = ChangeSetName
  { ChangeSetName -> Text
unChangeSetName :: Text
  }
  deriving newtype (Value -> Parser [ChangeSetName]
Value -> Parser ChangeSetName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChangeSetName]
$cparseJSONList :: Value -> Parser [ChangeSetName]
parseJSON :: Value -> Parser ChangeSetName
$cparseJSON :: Value -> Parser ChangeSetName
FromJSON, [ChangeSetName] -> Encoding
[ChangeSetName] -> Value
ChangeSetName -> Encoding
ChangeSetName -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChangeSetName] -> Encoding
$ctoEncodingList :: [ChangeSetName] -> Encoding
toJSONList :: [ChangeSetName] -> Value
$ctoJSONList :: [ChangeSetName] -> Value
toEncoding :: ChangeSetName -> Encoding
$ctoEncoding :: ChangeSetName -> Encoding
toJSON :: ChangeSetName -> Value
$ctoJSON :: ChangeSetName -> Value
ToJSON)

data ChangeSet = ChangeSet
  { ChangeSet -> UTCTime
csCreationTime :: UTCTime
  , ChangeSet -> Maybe [Change]
csChanges :: Maybe [Change]
  , ChangeSet -> ChangeSetName
csChangeSetName :: ChangeSetName
  , ChangeSet -> ExecutionStatus
csExecutionStatus :: ExecutionStatus
  , ChangeSet -> ChangeSetId
csChangeSetId :: ChangeSetId
  , ChangeSet -> Maybe [Parameter]
csParameters :: Maybe [Parameter]
  , ChangeSet -> StackId
csStackId :: StackId
  , ChangeSet -> Maybe [Capability]
csCapabilities :: Maybe [Capability]
  , ChangeSet -> Maybe [Tag]
csTags :: Maybe [Tag]
  , ChangeSet -> StackName
csStackName :: StackName
  , ChangeSet -> ChangeSetStatus
csStatus :: ChangeSetStatus
  , ChangeSet -> Maybe Text
csStatusReason :: Maybe Text
  , ChangeSet -> DescribeChangeSetResponse
csResponse :: DescribeChangeSetResponse
  }

changeSetJSON :: ChangeSet -> Text
changeSetJSON :: ChangeSet -> Text
changeSetJSON = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeSet -> DescribeChangeSetResponse
csResponse

changeSetFailed :: ChangeSet -> Bool
changeSetFailed :: ChangeSet -> Bool
changeSetFailed = (forall a. Eq a => a -> a -> Bool
== ChangeSetStatus
ChangeSetStatus_FAILED) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeSet -> ChangeSetStatus
csStatus

awsCloudFormationCreateChangeSet
  :: ( MonadUnliftIO m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasAwsEnv env
     )
  => StackName
  -> Maybe StackDescription
  -> StackTemplate
  -> [Parameter]
  -> [Capability]
  -> [Tag]
  -> m (Either Text (Maybe ChangeSet))
awsCloudFormationCreateChangeSet :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
 MonadReader env m, HasAwsEnv env) =>
StackName
-> Maybe StackDescription
-> StackTemplate
-> [Parameter]
-> [Capability]
-> [Tag]
-> m (Either Text (Maybe ChangeSet))
awsCloudFormationCreateChangeSet StackName
stackName Maybe StackDescription
mStackDescription StackTemplate
stackTemplate [Parameter]
parameters [Capability]
capabilities [Tag]
tags =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ServiceError -> Text
formatServiceError)
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m (Either a r)
trying (forall a. AsError a => Prism' a ServiceError
_ServiceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
hasStatus Int
400)
    forall a b. (a -> b) -> a -> b
$ do
      ChangeSetName
name <- forall (m :: * -> *). MonadIO m => m ChangeSetName
newChangeSetName

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Reading Template" Text -> [SeriesElem] -> Message
:# [Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackTemplate
stackTemplate]
      Text
templateBody <-
        Maybe StackDescription -> Text -> Text
addStackDescription Maybe StackDescription
mStackDescription
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m Text
readFileUtf8 (StackTemplate -> String
unStackTemplate StackTemplate
stackTemplate)

      Maybe Stack
mStack <- forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m (Maybe Stack)
awsCloudFormationDescribeStackMaybe StackName
stackName

      let changeSetType :: ChangeSetType
changeSetType = forall a. a -> Maybe a -> a
fromMaybe ChangeSetType
ChangeSetType_CREATE forall a b. (a -> b) -> a -> b
$ do
            Stack
stack <- Maybe Stack
mStack
            forall (f :: * -> *) a. Applicative f => a -> f a
pure
              forall a b. (a -> b) -> a -> b
$ if Stack -> Bool
stackIsAbandonedCreate Stack
stack
                then ChangeSetType
ChangeSetType_CREATE
                else ChangeSetType
ChangeSetType_UPDATE

      let req :: CreateChangeSet
req =
            Text -> Text -> CreateChangeSet
newCreateChangeSet (StackName -> Text
unStackName StackName
stackName) (ChangeSetName -> Text
unChangeSetName ChangeSetName
name)
              forall a b. a -> (a -> b) -> b
& (Lens' CreateChangeSet (Maybe ChangeSetType)
createChangeSet_changeSetType forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ChangeSetType
changeSetType)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' CreateChangeSet (Maybe Text)
createChangeSet_templateBody forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
templateBody)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' CreateChangeSet (Maybe [Parameter])
createChangeSet_parameters forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Parameter]
parameters)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' CreateChangeSet (Maybe [Capability])
createChangeSet_capabilities forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Capability]
capabilities)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' CreateChangeSet (Maybe [Tag])
createChangeSet_tags forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Tag]
tags)

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo
        forall a b. (a -> b) -> a -> b
$ Text
"Creating changeset..."
        Text -> [SeriesElem] -> Message
:# [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChangeSetName
name, Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChangeSetType
changeSetType]
      Text
csId <- forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"CreateChangeSet" CreateChangeSet
req (forall s a. s -> Getting a s a -> a
^. Lens' CreateChangeSetResponse (Maybe Text)
createChangeSetResponse_id)

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug Message
"Awaiting CREATE_COMPLETE"
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a) =>
Wait a -> a -> m Accept
awsAwait Wait DescribeChangeSet
newChangeSetCreateComplete forall a b. (a -> b) -> a -> b
$ Text -> DescribeChangeSet
newDescribeChangeSet Text
csId

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Retrieving changeset..."
      ChangeSet
cs <- forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
ChangeSetId -> m ChangeSet
awsCloudFormationDescribeChangeSet forall a b. (a -> b) -> a -> b
$ Text -> ChangeSetId
ChangeSetId Text
csId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ChangeSet
cs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ChangeSet -> Bool
changeSetFailed ChangeSet
cs)

awsCloudFormationDescribeChangeSet
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => ChangeSetId
  -> m ChangeSet
awsCloudFormationDescribeChangeSet :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
ChangeSetId -> m ChangeSet
awsCloudFormationDescribeChangeSet ChangeSetId
changeSetId = do
  let req :: DescribeChangeSet
req = Text -> DescribeChangeSet
newDescribeChangeSet forall a b. (a -> b) -> a -> b
$ ChangeSetId -> Text
unChangeSetId ChangeSetId
changeSetId
  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"DescribeChangeSet" DescribeChangeSet
req forall a b. (a -> b) -> a -> b
$ \AWSResponse DescribeChangeSet
resp ->
    UTCTime
-> Maybe [Change]
-> ChangeSetName
-> ExecutionStatus
-> ChangeSetId
-> Maybe [Parameter]
-> StackId
-> Maybe [Capability]
-> Maybe [Tag]
-> StackName
-> ChangeSetStatus
-> Maybe Text
-> DescribeChangeSetResponse
-> ChangeSet
ChangeSet
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe UTCTime)
describeChangeSetResponse_creationTime)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Change] -> [Change]
sortChanges forall a b. (a -> b) -> a -> b
$ AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe [Change])
describeChangeSetResponse_changes)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ChangeSetName
ChangeSetName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe Text)
describeChangeSetResponse_changeSetName)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe ExecutionStatus)
describeChangeSetResponse_executionStatus)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ChangeSetId
ChangeSetId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe Text)
describeChangeSetResponse_changeSetId)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe [Parameter])
describeChangeSetResponse_parameters)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> StackId
StackId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe Text)
describeChangeSetResponse_stackId)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe [Capability])
describeChangeSetResponse_capabilities)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe [Tag])
describeChangeSetResponse_tags)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> StackName
StackName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe Text)
describeChangeSetResponse_stackName)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse ChangeSetStatus
describeChangeSetResponse_status)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse DescribeChangeSet
resp forall s a. s -> Getting a s a -> a
^. Lens' DescribeChangeSetResponse (Maybe Text)
describeChangeSetResponse_statusReason)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure AWSResponse DescribeChangeSet
resp

sortChanges :: [Change] -> [Change]
sortChanges :: [Change] -> [Change]
sortChanges = forall k a. Ord k => (a -> k) -> (a -> [k]) -> [a] -> [a]
sortByDependencies Change -> Text
changeName Change -> [Text]
changeCausedBy

changeName :: Change -> Text
changeName :: Change -> Text
changeName Change
c = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ do
  ResourceChange' {Maybe [ResourceChangeDetail]
Maybe [ResourceAttribute]
Maybe Text
Maybe Replacement
Maybe ModuleInfo
Maybe ChangeAction
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
$sel:changeSetId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:moduleInfo:ResourceChange' :: ResourceChange -> Maybe ModuleInfo
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
changeSetId :: Maybe Text
action :: Maybe ChangeAction
..} <- Change -> Maybe ResourceChange
resourceChange Change
c
  Maybe Text
logicalResourceId

changeCausedBy :: Change -> [Text]
changeCausedBy :: Change -> [Text]
changeCausedBy Change
c = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ do
  ResourceChange' {Maybe [ResourceChangeDetail]
Maybe [ResourceAttribute]
Maybe Text
Maybe Replacement
Maybe ModuleInfo
Maybe ChangeAction
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
changeSetId :: Maybe Text
action :: Maybe ChangeAction
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
$sel:changeSetId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:moduleInfo:ResourceChange' :: ResourceChange -> Maybe ModuleInfo
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
..} <- Change -> Maybe ResourceChange
resourceChange Change
c
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ResourceChangeDetail -> Maybe Text
detailCausingLogicalResourceId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ResourceChangeDetail]
details

detailCausingLogicalResourceId :: ResourceChangeDetail -> Maybe Text
detailCausingLogicalResourceId :: ResourceChangeDetail -> Maybe Text
detailCausingLogicalResourceId ResourceChangeDetail' {Maybe Text
Maybe ResourceTargetDefinition
Maybe EvaluationType
Maybe ChangeSource
$sel:causingEntity:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe Text
$sel:changeSource:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe ChangeSource
$sel:evaluation:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe EvaluationType
$sel:target:ResourceChangeDetail' :: ResourceChangeDetail -> Maybe ResourceTargetDefinition
target :: Maybe ResourceTargetDefinition
evaluation :: Maybe EvaluationType
changeSource :: Maybe ChangeSource
causingEntity :: Maybe Text
..} =
  (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
causingEntity

awsCloudFormationExecuteChangeSet
  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => ChangeSetId -> m ()
awsCloudFormationExecuteChangeSet :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
ChangeSetId -> m ()
awsCloudFormationExecuteChangeSet ChangeSetId
changeSetId = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> m (AWSResponse a)
awsSend forall a b. (a -> b) -> a -> b
$ Text -> ExecuteChangeSet
newExecuteChangeSet forall a b. (a -> b) -> a -> b
$ ChangeSetId -> Text
unChangeSetId ChangeSetId
changeSetId

awsCloudFormationDeleteAllChangeSets
  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> m ()
awsCloudFormationDeleteAllChangeSets :: forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> m ()
awsCloudFormationDeleteAllChangeSets StackName
stackName = do
  forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Deleting all changesets"
  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> ConduitM () (AWSResponse a) m ()
awsPaginate (Text -> ListChangeSets
newListChangeSets forall a b. (a -> b) -> a -> b
$ StackName -> Text
unStackName StackName
stackName)
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> mono) -> ConduitT a (Element mono) m ()
concatMapC
      ( \ListChangeSetsResponse
resp -> forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ do
          [ChangeSetSummary]
ss <- ListChangeSetsResponse
resp forall s a. s -> Getting a s a -> a
^. Lens' ListChangeSetsResponse (Maybe [ChangeSetSummary])
listChangeSetsResponse_summaries
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ChangeSetSummary -> Maybe Text
Summary.changeSetId [ChangeSetSummary]
ss
      )
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
mapM_C
      ( \Text
csId -> do
          forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Enqueing delete" Text -> [SeriesElem] -> Message
:# [Key
"changeSetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
csId]
          forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> m (AWSResponse a)
awsSend forall a b. (a -> b) -> a -> b
$ Text -> DeleteChangeSet
newDeleteChangeSet Text
csId
      )

-- | Did we abandoned this Stack's first ever ChangeSet?
--
-- If you create a ChangeSet for a Stack that doesn't exist, but you don't
-- deploy it, then you attempt to create another ChangeSet, you need to use the
-- CREATE ChangeSetType still, or you'll get a "Stack does not exist" error.
--
-- This is despite the Stack very much existing, according to DescribeStacks,
-- with a creationTime, ARN, and everything.
--
-- Our hueristic for finding these is under review but with no previous
-- updates (no lastUpdatedTime), presumably meaning it's still in its /first/
-- review.
stackIsAbandonedCreate :: Stack -> Bool
stackIsAbandonedCreate :: Stack -> Bool
stackIsAbandonedCreate Stack
stack =
  Stack
stack
    forall s a. s -> Getting a s a -> a
^. Lens' Stack StackStatus
stack_stackStatus
    forall a. Eq a => a -> a -> Bool
== StackStatus
StackStatus_REVIEW_IN_PROGRESS
    Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing
      (Stack
stack forall s a. s -> Getting a s a -> a
^. Lens' Stack (Maybe UTCTime)
stack_lastUpdatedTime)

stackStatusRequiresDeletion :: Stack -> Maybe StackStatus
stackStatusRequiresDeletion :: Stack -> Maybe StackStatus
stackStatusRequiresDeletion Stack
stack =
  StackStatus
status
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (StackStatus
status forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StackStatus]
requiresDeletionStatuses)
 where
  status :: StackStatus
status = Stack
stack forall s a. s -> Getting a s a -> a
^. Lens' Stack StackStatus
stack_stackStatus

requiresDeletionStatuses :: [StackStatus]
requiresDeletionStatuses :: [StackStatus]
requiresDeletionStatuses =
  [StackStatus
StackStatus_ROLLBACK_COMPLETE, StackStatus
StackStatus_ROLLBACK_FAILED]

runningStatuses :: [StackStatus]
runningStatuses :: [StackStatus]
runningStatuses =
  [ StackStatus
StackStatus_CREATE_COMPLETE
  , StackStatus
StackStatus_UPDATE_COMPLETE
  , StackStatus
StackStatus_UPDATE_ROLLBACK_COMPLETE
  ]

_ValidationError :: AsError a => Getting (First ServiceError) a ServiceError
_ValidationError :: forall a. AsError a => Getting (First ServiceError) a ServiceError
_ValidationError =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
_MatchServiceError Service
defaultService ErrorCode
"ValidationError" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
hasStatus Int
400