stackctl (empty) → 1.1.0.0

raw patch · 42 files changed

+3309/−0 lines, 42 filesdep +Blammodep +Globdep +aeson

Dependencies added: Blammo, Glob, aeson, aeson-casing, aeson-pretty, amazonka, amazonka-cloudformation, amazonka-core, amazonka-ec2, amazonka-lambda, amazonka-sts, base, bytestring, cfn-flip, conduit, containers, errors, exceptions, extra, fast-logger, filepath, hspec, lens, lens-aeson, monad-logger, optparse-applicative, resourcet, rio, stackctl, text, time, unliftio, unliftio-core, unordered-containers, uuid, yaml

Files

• CHANGELOG.md +48/−0
• LICENSE +21/−0
• README.md +88/−0
• app/Main.hs +17/−0
• src/Stackctl/AWS.hs +8/−0
• src/Stackctl/AWS/CloudFormation.hs +445/−0
• src/Stackctl/AWS/Core.hs +114/−0
• src/Stackctl/AWS/EC2.hs +19/−0
• src/Stackctl/AWS/Lambda.hs +90/−0
• src/Stackctl/AWS/Orphans.hs +48/−0
• src/Stackctl/AWS/STS.hs +14/−0
• src/Stackctl/AWS/Scope.hs +32/−0
• src/Stackctl/Action.hs +117/−0
• src/Stackctl/CLI.hs +110/−0
• src/Stackctl/ColorOption.hs +36/−0
• src/Stackctl/Colors.hs +28/−0
• src/Stackctl/Commands.hs +85/−0
• src/Stackctl/DirectoryOption.hs +24/−0
• src/Stackctl/FilterOption.hs +65/−0
• src/Stackctl/Options.hs +40/−0
• src/Stackctl/Prelude.hs +32/−0
• src/Stackctl/Prompt.hs +44/−0
• src/Stackctl/Spec/Capture.hs +87/−0
• src/Stackctl/Spec/Cat.hs +183/−0
• src/Stackctl/Spec/Changes.hs +68/−0
• src/Stackctl/Spec/Changes/Format.hs +172/−0
• src/Stackctl/Spec/Deploy.hs +232/−0
• src/Stackctl/Spec/Discover.hs +107/−0
• src/Stackctl/Spec/Generate.hs +64/−0
• src/Stackctl/StackSpec.hs +131/−0
• src/Stackctl/StackSpecPath.hs +118/−0
• src/Stackctl/StackSpecYaml.hs +100/−0
• src/Stackctl/Subcommand.hs +41/−0
• src/Stackctl/VerboseOption.hs +37/−0
• src/Stackctl/Version.hs +12/−0
• src/UnliftIO/Exception/Lens.hs +33/−0
• stackctl.cabal +209/−0
• test/Spec.hs +2/−0
• test/Stackctl/AWS/CloudFormationSpec.hs +28/−0
• test/Stackctl/FilterOptionSpec.hs +35/−0
• test/Stackctl/StackSpecSpec.hs +50/−0
• test/Stackctl/StackSpecYamlSpec.hs +75/−0

@@ -0,0 +1,48 @@+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.0.0...main)++## [v1.1.0.0](https://github.com/freckle/stackctl/compare/v1.0.2.0...v1.1.0.0)++- Fix interleaved or out-of-order output bugs by streaming deployment events+  through the Logger instead of directly to `stdout`+- Logging goes to `stdout` by default (`LOG_DESTINATION` can still be used)+- The `changes` subcommand now requires a `PATH` argument++## [v1.0.2.0](https://github.com/freckle/stackctl/compare/v1.0.1.2...v1.0.2.0)++- Add `Stackctl.Action`++  Support for taking actions during Stack management, currently we support+  invoking a lambda post-deployment. In the future, we can add more, such as+  running local pre-deploy validation or preparation scripts.++- Add `awsCloudFormationDescribeStackOutputs`++## [v1.0.1.2](https://github.com/freckle/stackctl/compare/v1.0.1.1...v1.0.1.2)++- Always flush log messages before our own output++## [v1.0.1.1](https://github.com/freckle/stackctl/compare/v1.0.1.0...v1.0.1.1)++- Respect `LOG_DESTINATION` (the default remains `stderr`)++## [v1.0.1.0](https://github.com/freckle/stackctl/compare/v1.0.0.2...v1.0.1.0)++- Support reading CloudGenesis specifications++  - Accept account paths like `id.name` or `name.id`+  - Read `Parameters` as `Parameter{Key,Value}` or `{Name,Value}`++  This allows us to work with specifications directories originally implemented+  for, and potentially still used with, the CloudGenesis tooling.++## [v1.0.0.2](https://github.com/freckle/stackctl/compare/v1.0.0.1...v1.0.0.2)++- Fix tailing all events to read most recent, causing Throttling errors++## [v1.0.0.1](https://github.com/freckle/stackctl/compare/v1.0.0.0...v1.0.0.1)++- Fix non-portable paths issue in OSX executable build++## [v1.0.0.0](https://github.com/freckle/stackctl/tree/v1.0.0.0)++First release

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2022 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,88 @@+# Stackctl++Manage CloudFormation Stacks through specifications.++## About++`stackctl` is a command-line tool for working with [Stack Specifications][spec]. A Stack+Specification is a file-system format for describing deployed (or+to-be-deployed) CloudFormation Stacks including the Template, Parameters, and+Tags. `stackctl` can be used to pretty-print, diff, and deploy these+specifications.++[spec]: https://github.com/freckle/stackctl/blob/main/doc/stackctl.1.md#stack-specifications++This project also contains a Haskell library for doing the same.++## Install++### Binary install++Go to the [latest release][latest] and download the `.tar.gz` asset appropriate+for your OS. Navigate to the directory containing the downloaded file and run:++```console+tar xvf stackctl-*.tar.gz && cd stackctl+```++[latest]: https://github.com/freckle/stackctl/releases/latest++#### Global installation++Install into `/usr/local/`, with appropriate permissions:++```console+sudo make install+```++#### User installation++Set `PREFIX` to base the installation in a directory of your choosing:++```console+make install PREFIX=$HOME/.local+```++## Usage++Once installed, see:++- `stackctl --help`,+- `stackctl <command> --help`,+- `man 1 stackctl`, or+- `man 1 stackctl <command>`++The man pages are also available [in-repository](./doc), but contain+documentation as of `main`, and not your installed version.++## Relationship to CloudGenesis++[CloudGenesis][] is a project that also takes a directory of Stack+Specifications and deploys them when changed. Its on-disk format inspired ours+and, in fact, directories built for CloudGenesis can be managed by `stackctl`+(not necessarily the other way around).++[cloudgenesis]: https://github.com/LifeWay/CloudGenesis++The key differences are:++- CloudGenesis supplies AWS CodeBuild tooling for handling changes to your+  GitOps repository; Stackctl expects you to implement a GitHub Action that+  installs and executes `stackctl` commands as appropriate++  This makes Stackctl better if you need or want to also run the same tooling in+  a local context, but it makes CloudGenesis better if you need or want this+  activity to remain within the boundaries of your AWS VPC.++- CloudGenesis reacts to file-change events in S3, which only happens when you+  synchronize from `main`; Stackctl can run on any branch and easily be scoped+  to files changed in the PR or push.++  This enables Stackctl features like commenting with ChangeSet details on PRs,+  which are not possible in CloudGenesis as it's currently implemented.++- Stackctl adds the `Depends` key, for ordering multi-Stack processing++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)

@@ -0,0 +1,17 @@+module Main+  ( main+  ) where++import Stackctl.Prelude++import qualified Stackctl.Commands as Commands+import Stackctl.Subcommand++main :: IO ()+main =+  runSubcommand+    $ subcommand Commands.cat+    <> subcommand Commands.capture+    <> subcommand Commands.changes+    <> subcommand Commands.deploy+    <> subcommand Commands.version

@@ -0,0 +1,8 @@+module Stackctl.AWS+  ( module X+  ) where++import Stackctl.AWS.CloudFormation as X+import Stackctl.AWS.Core as X+import Stackctl.AWS.EC2 as X+import Stackctl.AWS.STS as X

@@ -0,0 +1,445 @@+module Stackctl.AWS.CloudFormation+  (+  -- * Stacks+    Stack(..)+  , stackIsRollbackComplete+  , StackId(..)+  , StackName(..)+  , 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+  , 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.Types+import qualified Amazonka.CloudFormation.Types.ChangeSetSummary as Summary+import Amazonka.CloudFormation.Waiters+import Amazonka.Core+  ( AsError+  , ServiceError+  , _MatchServiceError+  , _ServiceError+  , hasStatus+  , serviceCode+  , serviceMessage+  )+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 UnliftIO.Exception.Lens (handling_, trying)++newtype StackId = StackId+  { unStackId :: Text+  }+  deriving newtype (Eq, Ord, Show, FromJSON, ToJSON)++newtype StackName = StackName+  { unStackName :: Text+  }+  deriving newtype (Eq, Ord, Show, FromJSON, ToJSON)++newtype StackTemplate = StackTemplate+  { unStackTemplate :: FilePath+  }+  deriving stock (Eq, Show)+  deriving newtype FromJSON++data StackDeployResult+  = StackCreateSuccess+  | StackCreateFailure Bool+  | StackUpdateSuccess+  | StackUpdateFailure Bool+  deriving stock Show++prettyStackDeployResult :: StackDeployResult -> Text+prettyStackDeployResult = \case+  StackCreateSuccess -> "Created Stack successfully"+  StackCreateFailure{} -> "Failed to create Stack"+  StackUpdateSuccess -> "Updated Stack successfully"+  StackUpdateFailure{} -> "Failed to update Stack"++stackCreateResult :: Accept -> StackDeployResult+stackCreateResult = \case+  AcceptSuccess -> StackCreateSuccess+  AcceptFailure -> StackCreateFailure False+  AcceptRetry -> StackCreateFailure True++stackUpdateResult :: Accept -> StackDeployResult+stackUpdateResult = \case+  AcceptSuccess -> StackUpdateSuccess+  AcceptFailure -> StackUpdateFailure False+  AcceptRetry -> StackUpdateFailure True++data StackDeleteResult+  = StackDeleteSuccess+  | StackDeleteFailure Bool++prettyStackDeleteResult :: StackDeleteResult -> Text+prettyStackDeleteResult = \case+  StackDeleteSuccess -> "Deleted Stack successfully"+  StackDeleteFailure{} -> "Failed to delete Stack"++stackDeleteResult :: Accept -> StackDeleteResult+stackDeleteResult = \case+  AcceptSuccess -> StackDeleteSuccess+  AcceptFailure -> StackDeleteFailure False+  AcceptRetry -> StackDeleteFailure True++-- | @stackctl-{timestamp}-{uuid}@+newChangeSetName :: MonadIO m => m ChangeSetName+newChangeSetName = liftIO $ do+  timestamp <- formatTime defaultTimeLocale "%Y%m%d%H%M" <$> getCurrentTime+  uuid <- UUID.toString <$> UUID.nextRandom+  let parts = ["stackctl", timestamp, uuid]+  pure $ ChangeSetName $ T.intercalate "-" $ map pack parts++awsCloudFormationDescribeStack+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName -> m Stack+awsCloudFormationDescribeStack stackName = do+  let+    req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName++  awsSimple "DescribeStack" req $ \resp -> do+    stacks <- resp ^. describeStacksResponse_stacks+    listToMaybe stacks++awsCloudFormationDescribeStackMaybe+  :: (MonadUnliftIO m, MonadResource m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m (Maybe Stack)+awsCloudFormationDescribeStackMaybe 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+  handling_ _ValidationError (pure Nothing) $ do+    Just <$> awsCloudFormationDescribeStack stackName++awsCloudFormationDescribeStackOutputs+  :: (MonadResource m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m [Output]+awsCloudFormationDescribeStackOutputs stackName = do+  stack <- awsCloudFormationDescribeStack stackName+  pure $ fromMaybe [] $ outputs stack++awsCloudFormationDescribeStackEvents+  :: (MonadResource m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> Maybe Text -- ^ Last-seen Id+  -> m [StackEvent]+awsCloudFormationDescribeStackEvents stackName mLastId = do+  let+    req =+      newDescribeStackEvents+        & describeStackEvents_stackName+        ?~ unStackName stackName++  runConduit+    $ awsPaginate req+    .| mapC (fromMaybe [] . (^. describeStackEventsResponse_stackEvents))+    .| concatC+    .| takeWhileC (\e -> Just (e ^. stackEvent_eventId) /= mLastId)+    .| sinkList++awsCloudFormationGetMostRecentStackEventId+  :: (MonadResource m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m (Maybe Text)+awsCloudFormationGetMostRecentStackEventId stackName = do+  let+    req =+      newDescribeStackEvents+        & describeStackEvents_stackName+        ?~ unStackName stackName++    -- Events are returned most-recent first, so "last" is "first" here+    getFirstEventId :: [StackEvent] -> Maybe Text+    getFirstEventId = \case+      [] -> Nothing+      (e : _) -> Just $ e ^. stackEvent_eventId++  awsSimple "DescribeStackEvents" req+    $ pure+    . getFirstEventId+    . fromMaybe []+    . (^. describeStackEventsResponse_stackEvents)++awsCloudFormationDeleteStack+  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m StackDeleteResult+awsCloudFormationDeleteStack stackName = do+  let+    deleteReq = newDeleteStack $ unStackName stackName+    describeReq =+      newDescribeStacks & describeStacks_stackName ?~ unStackName stackName++  awsSimple "DeleteStack" deleteReq $ const $ pure ()++  logDebug "Awaiting DeleteStack"+  stackDeleteResult <$> awsAwait newStackDeleteComplete describeReq++awsCloudFormationWait+  :: (MonadUnliftIO m, MonadResource m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m StackDeployResult+awsCloudFormationWait stackName = do+  either stackCreateResult stackUpdateResult <$> race+    (awsAwait newStackCreateComplete req)+    (awsAwait newStackUpdateComplete req)+ where+  req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName++awsCloudFormationGetTemplate+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName -> m Value+awsCloudFormationGetTemplate stackName = do+  let+    req =+      newGetTemplate+        & (getTemplate_stackName ?~ unStackName stackName)+        . (getTemplate_templateStage ?~ TemplateStage_Original)++    -- If decodeStrict fails, assume it's a String of Yaml. See writeStackSpec.+    decodeTemplateBody body =+      fromMaybe (toJSON body) $ decodeStrict $ encodeUtf8 body++  awsSimple "GetTemplate" req $ \resp -> do+    body <- resp ^. getTemplateResponse_templateBody+    pure $ decodeTemplateBody body++makeParameter :: Text -> Maybe Text -> Parameter+makeParameter k v =+  newParameter & (parameter_parameterKey ?~ k) . (parameter_parameterValue .~ v)++readParameter :: String -> Either String Parameter+readParameter x = case T.breakOn "=" $ pack x of+  (key, _) | T.null key -> invalid "empty KEY"+  (_, value) | T.null value -> invalid "empty VALUE"+  (_, "=") -> invalid "empty VALUE" -- Is supporting { k, Nothing } valuable?+  (pName, value) -> Right $ makeParameter pName $ Just $ T.drop 1 value+ where+  invalid msg = Left $ "Invalid format for parameter (KEY=VALUE): " <> msg++newtype ChangeSetId = ChangeSetId+  { unChangeSetId :: Text+  }+  deriving newtype (FromJSON, ToJSON)++newtype ChangeSetName = ChangeSetName+  { unChangeSetName :: Text+  }+  deriving newtype (FromJSON, ToJSON)++data ChangeSet = ChangeSet+  { csCreationTime :: UTCTime+  , csChanges :: Maybe [Change]+  , csChangeSetName :: ChangeSetName+  , csExecutionStatus :: ExecutionStatus+  , csChangeSetId :: ChangeSetId+  , csParameters :: Maybe [Parameter]+  , csStackId :: StackId+  , csCapabilities :: Maybe [Capability]+  , csTags :: Maybe [Tag]+  , csStackName :: StackName+  , csStatus :: ChangeSetStatus+  , csStatusReason :: Maybe Text+  , csResponse :: DescribeChangeSetResponse+  }++changeSetJSON :: ChangeSet -> Text+changeSetJSON = decodeUtf8 . BSL.toStrict . encodePretty . csResponse++changeSetFailed :: ChangeSet -> Bool+changeSetFailed = (== ChangeSetStatus_FAILED) . csStatus++awsCloudFormationCreateChangeSet+  :: ( MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsEnv env+     )+  => StackName+  -> StackTemplate+  -> [Parameter]+  -> [Capability]+  -> [Tag]+  -> m (Either Text (Maybe ChangeSet))+awsCloudFormationCreateChangeSet stackName stackTemplate parameters capabilities tags+  = fmap (first formatServiceError)+    $ trying (_ServiceError . hasStatus 400)+    $ do+        name <- newChangeSetName+        templateBody <- readFileUtf8 $ unStackTemplate stackTemplate++        mStack <- awsCloudFormationDescribeStackMaybe stackName+        let+          changeSetType = fromMaybe ChangeSetType_CREATE $ do+            stack <- mStack+            pure $ if stackIsAbandonedCreate stack+              then ChangeSetType_CREATE+              else ChangeSetType_UPDATE++        let+          req =+            newCreateChangeSet (unStackName stackName) (unChangeSetName name)+              & (createChangeSet_changeSetType ?~ changeSetType)+              . (createChangeSet_templateBody ?~ templateBody)+              . (createChangeSet_parameters ?~ parameters)+              . (createChangeSet_capabilities ?~ capabilities)+              . (createChangeSet_tags ?~ tags)++        logInfo "Creating changeset..."+        csId <- awsSimple "CreateChangeSet" req (^. createChangeSetResponse_id)++        logDebug "Awaiting CREATE_COMPLETE"+        void $ awsAwait newChangeSetCreateComplete $ newDescribeChangeSet csId++        logInfo "Retrieving changeset..."+        cs <- awsCloudFormationDescribeChangeSet $ ChangeSetId csId+        pure $ cs <$ guard (not $ changeSetFailed cs)++awsCloudFormationDescribeChangeSet+  :: (MonadResource m, MonadReader env m, HasAwsEnv env)+  => ChangeSetId+  -> m ChangeSet+awsCloudFormationDescribeChangeSet changeSetId = do+  let req = newDescribeChangeSet $ unChangeSetId changeSetId+  awsSimple "DescribeChangeSet" req $ \resp ->+    ChangeSet+      <$> (resp ^. describeChangeSetResponse_creationTime)+      <*> pure (resp ^. describeChangeSetResponse_changes)+      <*> (ChangeSetName <$> resp ^. describeChangeSetResponse_changeSetName)+      <*> (resp ^. describeChangeSetResponse_executionStatus)+      <*> (ChangeSetId <$> resp ^. describeChangeSetResponse_changeSetId)+      <*> pure (resp ^. describeChangeSetResponse_parameters)+      <*> (StackId <$> resp ^. describeChangeSetResponse_stackId)+      <*> pure (resp ^. describeChangeSetResponse_capabilities)+      <*> pure (resp ^. describeChangeSetResponse_tags)+      <*> (StackName <$> resp ^. describeChangeSetResponse_stackName)+      <*> pure (resp ^. describeChangeSetResponse_status)+      <*> pure (resp ^. describeChangeSetResponse_statusReason)+      <*> pure resp++awsCloudFormationExecuteChangeSet+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => ChangeSetId -> m ()+awsCloudFormationExecuteChangeSet changeSetId = do+  void $ awsSend $ newExecuteChangeSet $ unChangeSetId changeSetId++awsCloudFormationDeleteAllChangeSets+  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> m ()+awsCloudFormationDeleteAllChangeSets stackName = do+  logInfo "Deleting all changesets"+  runConduit+    $ awsPaginate (newListChangeSets $ unStackName stackName)+    .| concatMapC+         (\resp -> fromMaybe [] $ do+           ss <- resp ^. listChangeSetsResponse_summaries+           pure $ mapMaybe Summary.changeSetId ss+         )+    .| mapM_C+         (\csId -> do+           logInfo $ "Enqueing delete" :# ["changeSetId" .= csId]+           void $ awsSend $ newDeleteChangeSet 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 =+  stack ^. stack_stackStatus == StackStatus_REVIEW_IN_PROGRESS && isNothing+    (stack ^. stack_lastUpdatedTime)++stackIsRollbackComplete :: Stack -> Bool+stackIsRollbackComplete stack =+  stack ^. stack_stackStatus == StackStatus_ROLLBACK_COMPLETE++_ValidationError :: AsError a => Getting (First ServiceError) a ServiceError+_ValidationError =+  _MatchServiceError defaultService "ValidationError" . hasStatus 400++formatServiceError :: ServiceError -> Text+formatServiceError e = mconcat+  [ toText $ e ^. serviceCode+  , maybe "" ((": " <>) . toText) $ e ^. serviceMessage+  ]

@@ -0,0 +1,114 @@+module Stackctl.AWS.Core+  (+  -- * AWS via 'MonadReader'+    AwsEnv+  , HasAwsEnv(..)+  , awsEnvDiscover+  , awsSimple+  , awsSend+  , awsPaginate+  , awsAwait++  -- * Modifiers on 'AwsEnv'+  , awsWithin++  -- * 'Amazonka' extensions+  , AccountId(..)++  -- * 'Amazonka'/'ResourceT' re-exports+  , Region(..)+  , FromText(..)+  , ToText(..)+  , MonadResource+  ) where++import Stackctl.Prelude++import Amazonka hiding (LogLevel(..))+import qualified Amazonka as AWS+import Conduit (ConduitM)+import Control.Monad.Logger (defaultLoc, toLogStr)+import Control.Monad.Trans.Resource (MonadResource)+import Stackctl.AWS.Orphans ()++newtype AwsEnv = AwsEnv+  { unAwsEnv :: Env+  }++unL :: Lens' AwsEnv Env+unL = lens unAwsEnv $ \x y -> x { unAwsEnv = y }++awsEnvDiscover :: MonadLoggerIO m => m AwsEnv+awsEnvDiscover = do+  env <- liftIO $ newEnv discover+  AwsEnv <$> configureLogging env++configureLogging :: MonadLoggerIO m => Env -> m Env+configureLogging env = do+  loggerIO <- askLoggerIO+  pure $ env+    { AWS.envLogger = \level msg -> do+      loggerIO+        defaultLoc -- TODO: there may be a way to get a CallStack/Loc+        "Amazonka"+        (case level of+          AWS.Info -> LevelInfo+          AWS.Error -> LevelError+          AWS.Debug -> LevelDebug+          AWS.Trace -> LevelOther "trace"+        )+        (toLogStr msg)+    }++class HasAwsEnv env where+  awsEnvL :: Lens' env AwsEnv++instance HasAwsEnv AwsEnv where+  awsEnvL = id++awsSimple+  :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a)+  => Text+  -> a+  -> (AWSResponse a -> Maybe b)+  -> m b+awsSimple name req post = do+  resp <- awsSend req+  maybe (throwString err) pure $ post resp+  where err = unpack name <> " successful, but processing the response failed"++awsSend+  :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a)+  => a+  -> m (AWSResponse a)+awsSend req = do+  AwsEnv env <- view awsEnvL+  send env req++awsPaginate+  :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a)+  => a+  -> ConduitM () (AWSResponse a) m ()+awsPaginate req = do+  AwsEnv env <- view awsEnvL+  paginateEither env req >>= hoistEither++hoistEither :: MonadIO m => Either Error a -> m a+hoistEither = either (liftIO . throwIO) pure++awsAwait+  :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a)+  => Wait a+  -> a+  -> m Accept+awsAwait w req = do+  AwsEnv env <- view awsEnvL+  await env w req++awsWithin :: (MonadReader env m, HasAwsEnv env) => Region -> m a -> m a+awsWithin r = local $ over (awsEnvL . unL) (within r)++newtype AccountId = AccountId+  { unAccountId :: Text+  }+  deriving newtype (Eq, Ord, ToJSON)

@@ -0,0 +1,19 @@+module Stackctl.AWS.EC2+  ( awsEc2DescribeFirstAvailabilityZoneRegionName+  ) where++import Stackctl.Prelude++import Amazonka.EC2.DescribeAvailabilityZones+import Amazonka.EC2.Types (AvailabilityZone(..))+import Stackctl.AWS.Core++awsEc2DescribeFirstAvailabilityZoneRegionName+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m Region+awsEc2DescribeFirstAvailabilityZoneRegionName = do+  let req = newDescribeAvailabilityZones+  awsSimple "DescribeAvailabilityZones" req $ \resp -> do+    azs <- resp ^. describeAvailabilityZonesResponse_availabilityZones+    az <- listToMaybe azs+    rn <- regionName az+    hush $ fromText rn

@@ -0,0 +1,90 @@+{-# LANGUAGE MultiWayIf #-}++module Stackctl.AWS.Lambda+  ( LambdaInvokeResult(..)+  , LambdaError(..)+  , logLambdaInvocationResult+  , isLambdaInvocationSuccess+  , awsLambdaInvoke+  ) where++import Stackctl.Prelude hiding (trace)++import Amazonka.Lambda.Invoke+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL+import Stackctl.AWS.Core++data LambdaInvokeResult+  = LambdaInvokeSuccess+  | LambdaInvokeError LambdaError (Maybe Text)+  | LambdaInvokeFailure Int (Maybe Text)+  deriving stock Show++logLambdaInvocationResult :: MonadLogger m => LambdaInvokeResult -> m ()+logLambdaInvocationResult = \case+  LambdaInvokeSuccess -> logInfo "LambdaInvokeSuccess"+  LambdaInvokeError LambdaError {..} mFunctionError ->+    logError $ (:# []) $ mconcat+      [ "LambdaInvokeError"+      , "\n  errorType: " <> errorType+      , "\n  errorMessage: " <> errorMessage+      , "\n  trace: "+      , mconcat $ map ("\n    " <>) trace+      , "\n  FunctionError: " <> fromMaybe "none" mFunctionError+      ]+  LambdaInvokeFailure status mFunctionError -> logError $ (:# []) $ mconcat+    [ "LambdaInvokeFailure"+    , "\n  StatusCode: " <> pack (show status)+    , "\n  FunctionError: " <> fromMaybe "none" mFunctionError+    ]++isLambdaInvocationSuccess :: LambdaInvokeResult -> Bool+isLambdaInvocationSuccess = \case+  LambdaInvokeSuccess -> True+  LambdaInvokeError{} -> False+  LambdaInvokeFailure{} -> False++data LambdaError = LambdaError+  { errorType :: Text+  , errorMessage :: Text+  , trace :: [Text]+  }+  deriving stock (Show, Generic)+  deriving anyclass (FromJSON, ToJSON)++awsLambdaInvoke+  :: ( MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsEnv env+     , ToJSON a+     )+  => Text+  -> a -- ^ Payload+  -> m LambdaInvokeResult+awsLambdaInvoke name payload = do+  logDebug $ "Invoking function" :# ["name" .= name]++  resp <- awsSend $ newInvoke name $ BSL.toStrict $ encode payload++  let+    status = resp ^. invokeResponse_statusCode+    mError = decode . BSL.fromStrict =<< resp ^. invokeResponse_payload+    mFunctionError = resp ^. invokeResponse_functionError++  logDebug+    $ "Function result"+    :# [ "name" .= name+       , "status" .= status+       , "error" .= mError+       , "functionError" .= mFunctionError+       ]++  pure $ if+    | statusIsUnsuccessful status -> LambdaInvokeFailure status mFunctionError+    | Just e <- mError            -> LambdaInvokeError e mFunctionError+    | otherwise                   -> LambdaInvokeSuccess++statusIsUnsuccessful :: Int -> Bool+statusIsUnsuccessful s = s < 200 || s >= 300

@@ -0,0 +1,48 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+--+-- Orphans so we can get @'ToJSON' 'ChangeSet'@ without hand-writing a massive,+-- incomplete, and doomed-to-drift instance ourselves.+--+module Stackctl.AWS.Orphans+  () where++import Stackctl.Prelude++import Amazonka.CloudFormation.DescribeChangeSet+import Amazonka.CloudFormation.Types+import Data.Aeson+import GHC.Generics (Rep)++-- Makes it syntactally easier to do a bunch of these+newtype Generically a = Generically { unGenerically :: a }+instance+  ( Generic a+  , GToJSON' Value Zero (Rep a)+  , GToJSON' Encoding Zero (Rep a)+  ) => ToJSON (Generically a) where+  toJSON = genericToJSON defaultOptions . unGenerically+  toEncoding = genericToEncoding defaultOptions . unGenerically++deriving via (Generically DescribeChangeSetResponse)+  instance ToJSON DescribeChangeSetResponse+deriving via (Generically Tag)+  instance ToJSON Tag+deriving via (Generically Parameter)+  instance ToJSON Parameter+deriving via (Generically RollbackConfiguration)+  instance ToJSON RollbackConfiguration+deriving via (Generically RollbackTrigger)+  instance ToJSON RollbackTrigger+deriving via (Generically Change)+  instance ToJSON Change+deriving via (Generically ResourceChange)+  instance ToJSON ResourceChange+deriving via (Generically ModuleInfo)+  instance ToJSON ModuleInfo+deriving via (Generically ResourceChangeDetail)+  instance ToJSON ResourceChangeDetail+deriving via (Generically ResourceTargetDefinition)+  instance ToJSON ResourceTargetDefinition

@@ -0,0 +1,14 @@+module Stackctl.AWS.STS+  ( awsGetCallerIdentityAccount+  ) where++import Stackctl.Prelude++import Amazonka.STS.GetCallerIdentity+import Stackctl.AWS.Core++awsGetCallerIdentityAccount+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m AccountId+awsGetCallerIdentityAccount = do+  awsSimple "GetCallerIdentity" newGetCallerIdentity $ \resp -> do+    AccountId <$> resp ^. getCallerIdentityResponse_account

@@ -0,0 +1,32 @@+module Stackctl.AWS.Scope+  ( AwsScope(..)+  , HasAwsScope(..)+  , fetchAwsScope+  ) where++import Stackctl.Prelude++import Stackctl.AWS+import System.Environment (lookupEnv)++data AwsScope = AwsScope+  { awsAccountId :: AccountId+  , awsAccountName :: Text+  , awsRegion :: Region+  }+  deriving stock Generic+  deriving anyclass ToJSON++class HasAwsScope env where+  awsScopeL :: Lens' env AwsScope++instance HasAwsScope AwsScope where+  awsScopeL = id++fetchAwsScope+  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m AwsScope+fetchAwsScope =+  AwsScope+    <$> awsGetCallerIdentityAccount+    <*> liftIO (maybe "unknown" pack <$> lookupEnv "AWS_PROFILE")+    <*> awsEc2DescribeFirstAvailabilityZoneRegionName

@@ -0,0 +1,117 @@+{-# LANGUAGE NamedFieldPuns #-}++-- | Actions that can be performed on certain Stack management events+--+-- For example, to invoke a Lambda whose name is found in the deploying Stack's+-- outputs after it's been deployed:+--+-- @+-- Actions:+--   - on: PostDeploy+--     run:+--       InvokeLambdaByStackOutput: OnDeployFunction+-- @+--+module Stackctl.Action+  ( Action+  , newAction+  , ActionOn(..)+  , ActionRun(..)+  , runActions+  ) where++import Stackctl.Prelude hiding (on)++import Data.Aeson+import Data.List (find)+import Stackctl.AWS+import Stackctl.AWS.Lambda++data Action = Action+  { on :: ActionOn+  , run :: ActionRun+  }+  deriving stock Generic+  deriving anyclass (FromJSON, ToJSON)++newAction :: ActionOn -> ActionRun -> Action+newAction = Action++data ActionOn = PostDeploy+  deriving stock (Eq, Generic)++instance FromJSON ActionOn where+  parseJSON = withText "ActionOn" $ \case+    "PostDeploy" -> pure PostDeploy+    x ->+      fail $ "Invalid ActionOn: " <> show x <> ", must be one of [PostDeploy]"++instance ToJSON ActionOn where+  toJSON = \case+    PostDeploy -> toJSON @Text "PostDeploy"+  toEncoding = \case+    PostDeploy -> toEncoding @Text "PostDeploy"++data ActionRun+  = InvokeLambdaByStackOutput Text+  | InvokeLambdaByName Text++instance FromJSON ActionRun where+  parseJSON = withObject "ActionRun" $ \o -> asum+    [ InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByStackOutput"+    , InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByName"+    ]++instance ToJSON ActionRun where+  toJSON = object . \case+    InvokeLambdaByStackOutput name -> ["InvokeLambdaByStackOutput" .= name]+    InvokeLambdaByName name -> ["InvokeLambdaByName" .= name]+  toEncoding = pairs . \case+    InvokeLambdaByStackOutput name -> "InvokeLambdaByStackOutput" .= name+    InvokeLambdaByName name -> "InvokeLambdaByName" .= name++data ActionFailure+  = NoSuchOutput StackName Text [Output]+  | InvokeLambdaFailure LambdaInvokeResult+  deriving stock Show+  deriving anyclass Exception++runActions+  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> ActionOn+  -> [Action]+  -> m ()+runActions stackName on =+  traverse_ (runAction stackName) . filter (`shouldRunOn` on)++shouldRunOn :: Action -> ActionOn -> Bool+shouldRunOn Action { on } on' = on == on'++runAction+  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+  => StackName+  -> Action+  -> m ()+runAction stackName Action { on, run } = do+  logInfo $ "Running action" :# ["on" .= on, "run" .= run]++  case run of+    InvokeLambdaByStackOutput outputName -> do+      outputs <- awsCloudFormationDescribeStackOutputs stackName+      case findOutputValue outputName outputs of+        Nothing -> throwIO $ NoSuchOutput stackName outputName outputs+        Just name -> invoke name+    InvokeLambdaByName name -> invoke name+ where+  invoke name = do+    result <- awsLambdaInvoke name payload+    logLambdaInvocationResult result+    unless (isLambdaInvocationSuccess result) $ throwIO $ InvokeLambdaFailure+      result++  payload = object ["stack" .= stackName, "event" .= on]++findOutputValue :: Text -> [Output] -> Maybe Text+findOutputValue name =+  view output_outputValue <=< find ((== Just name) . view output_outputKey)

@@ -0,0 +1,110 @@+module Stackctl.CLI+  ( App+  , optionsL+  , AppT+  , runAppT+  ) where++import Stackctl.Prelude++import qualified Blammo.Logging.LogSettings.Env as LoggingEnv+import Control.Monad.Catch (MonadCatch)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.ColorOption+import Stackctl.DirectoryOption+import Stackctl.FilterOption+import Stackctl.VerboseOption++data App options = App+  { appLogger :: Logger+  , appOptions :: options+  , appAwsScope :: AwsScope+  , appAwsEnv :: AwsEnv+  }++optionsL :: Lens' (App options) options+optionsL = lens appOptions $ \x y -> x { appOptions = y }++instance HasLogger (App options) where+  loggerL = lens appLogger $ \x y -> x { appLogger = y }++instance HasAwsScope (App options) where+  awsScopeL = lens appAwsScope $ \x y -> x { appAwsScope = y }++instance HasAwsEnv (App options) where+  awsEnvL = lens appAwsEnv $ \x y -> x { appAwsEnv = y }++instance HasDirectoryOption options => HasDirectoryOption (App options) where+  directoryOptionL = optionsL . directoryOptionL++instance HasFilterOption options => HasFilterOption (App options) where+  filterOptionL = optionsL . filterOptionL++instance HasColorOption options => HasColorOption (App options) where+  colorOptionL = optionsL . colorOptionL++instance HasVerboseOption options => HasVerboseOption (App options) where+  verboseOptionL = optionsL . verboseOptionL++newtype AppT app m a = AppT+  { unAppT :: ReaderT app (LoggingT (ResourceT m)) a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadUnliftIO+    , MonadResource+    , MonadReader app+    , MonadLogger+    , MonadThrow+    , MonadCatch+    , MonadMask+    )++runAppT+  :: ( MonadMask m+     , MonadUnliftIO m+     , HasColorOption options+     , HasVerboseOption options+     )+  => options+  -> AppT (App options) m a+  -> m a+runAppT options f = do+  envLogSettings <- liftIO LoggingEnv.parse++  logger <- newLogger $ adjustLogSettings+    (options ^. colorOptionL)+    (options ^. verboseOptionL)+    envLogSettings++  aws <- runLoggerLoggingT logger awsEnvDiscover++  let+    runAws+      :: MonadUnliftIO m => ReaderT AwsEnv (LoggingT (ResourceT m)) a -> m a+    runAws = runResourceT . runLoggerLoggingT logger . flip runReaderT aws++  app <- App logger options <$> runAws fetchAwsScope <*> pure aws++  let+    AwsScope {..} = appAwsScope app++    context =+      [ "region" .= awsRegion+      , "accountId" .= awsAccountId+      , "accountName" .= awsAccountName+      ]++  runResourceT+    $ runLoggerLoggingT app+    $ flip runReaderT app+    $ withThreadContext context+    $ unAppT f++adjustLogSettings :: LogColor -> Verbosity -> LogSettings -> LogSettings+adjustLogSettings lc v = setLogSettingsColor lc . verbositySetLogLevels v

@@ -0,0 +1,36 @@+module Stackctl.ColorOption+  ( LogColor(..)+  , HasColorOption(..)+  , colorOption+  , colorHandle+  ) where++import Stackctl.Prelude++import Blammo.Logging.LogSettings+import Options.Applicative++class HasColorOption env where+  colorOptionL :: Lens' env LogColor++instance HasColorOption LogColor where+  colorOptionL = id++colorOption :: Parser LogColor+colorOption = option (eitherReader readLogColor) $ mconcat+  [ long "color"+  , help "When to colorize output"+  , metavar "auto|always|never"+  , value LogColorAuto+  , showDefaultWith showLogColor+  ]++showLogColor :: LogColor -> String+showLogColor = \case+  LogColorAuto -> "auto"+  LogColorAlways -> "always"+  LogColorNever -> "never"++colorHandle :: MonadIO m => Handle -> LogColor -> m Bool+colorHandle h lc = shouldColorHandle settings h+  where settings = setLogSettingsColor lc defaultLogSettings

@@ -0,0 +1,28 @@+-- | Facilities for colorizing output+module Stackctl.Colors+  ( Colors(..)+  , HasColorOption+  , getColorsStdout+  , noColors+  ) where++import Stackctl.Prelude++import Blammo.Logging.Colors+import Stackctl.ColorOption (HasColorOption(..), colorHandle)++-- | Return 'Colors' based on options and 'stdout'+getColorsStdout+  :: (MonadIO m, MonadReader env m, HasColorOption env) => m Colors+getColorsStdout = getColorsHandle stdout++-- | Return 'Colors' based on options given 'Handle'+getColorsHandle+  :: (MonadIO m, MonadReader env m, HasColorOption env) => Handle -> m Colors+getColorsHandle h = do+  colorOption <- view colorOptionL+  c <- colorHandle h colorOption+  pure $ getColors c++noColors :: Colors+noColors = getColors False

@@ -0,0 +1,85 @@+module Stackctl.Commands+  ( cat+  , capture+  , changes+  , deploy+  , version+  ) where++import Stackctl.Prelude++import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.ColorOption+import Stackctl.DirectoryOption+import Stackctl.FilterOption+import Stackctl.Spec.Capture+import Stackctl.Spec.Cat+import Stackctl.Spec.Changes+import Stackctl.Spec.Deploy+import Stackctl.Subcommand+import Stackctl.Version++cat+  :: ( HasLogger env+     , HasAwsScope env+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => Subcommand CatOptions env+cat = Subcommand+  { name = "cat"+  , description = "Pretty-print specifications"+  , parse = runCatOptions+  , run = runCat+  }++capture+  :: (HasAwsScope env, HasAwsEnv env, HasDirectoryOption env)+  => Subcommand CaptureOptions env+capture = Subcommand+  { name = "capture"+  , description = "Capture deployed Stacks as specifications"+  , parse = runCaptureOptions+  , run = runCapture+  }++changes+  :: ( HasAwsScope env+     , HasAwsEnv env+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => Subcommand ChangesOptions env+changes = Subcommand+  { name = "changes"+  , description = "Review changes between specification and deployed state"+  , parse = runChangesOptions+  , run = runChanges+  }++deploy+  :: ( HasLogger env+     , HasAwsScope env+     , HasAwsEnv env+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => Subcommand DeployOptions env+deploy = Subcommand+  { name = "deploy"+  , description = "Deploy specifications"+  , parse = runDeployOptions+  , run = runDeploy+  }++version :: Subcommand () env+version = Subcommand+  { name = "version"+  , description = "Output the version"+  , parse = pure ()+  , run = \() -> logVersion+  }

@@ -0,0 +1,24 @@+module Stackctl.DirectoryOption+  ( HasDirectoryOption(..)+  , directoryOption+  ) where++import Stackctl.Prelude++import Options.Applicative++class HasDirectoryOption env where+  directoryOptionL :: Lens' env FilePath++instance HasDirectoryOption FilePath where+  directoryOptionL = id++directoryOption :: Parser FilePath+directoryOption = option str $ mconcat+  [ short 'd'+  , long "directory"+  , metavar "PATH"+  , help "Operate on specifications in PATH"+  , value "."+  , showDefault+  ]

@@ -0,0 +1,65 @@+module Stackctl.FilterOption+  ( FilterOption+  , HasFilterOption(..)+  , filterOption+  , filterOptionFromPaths+  , filterFilePaths+  ) where++import Stackctl.Prelude++import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Options.Applicative+import System.FilePath.Glob++newtype FilterOption = FilterOption+  { unFilterOption :: NonEmpty Pattern+  }++instance ToJSON FilterOption where+  toJSON = toJSON . showFilterOption+  toEncoding = toEncoding . showFilterOption++class HasFilterOption env where+  filterOptionL :: Lens' env FilterOption++instance HasFilterOption FilterOption where+  filterOptionL = id++filterOption :: String -> Parser FilterOption+filterOption items = option (eitherReader readFilterOption) $ mconcat+  [ long "filter"+  , metavar "PATTERN[,PATTERN]"+  , help $ "Filter " <> items <> " to match PATTERN(s)"+  , value defaultFilterOption+  , showDefaultWith showFilterOption+  ]++filterOptionFromPaths :: NonEmpty FilePath -> FilterOption+filterOptionFromPaths = FilterOption . fmap compile++readFilterOption :: String -> Either String FilterOption+readFilterOption =+  maybe (Left err) (Right . FilterOption)+    . NE.nonEmpty+    . map (compile . unpack)+    . filter (not . T.null)+    . map T.strip+    . T.splitOn ","+    . pack+  where err = "Must be non-empty, comma-separated list of non-empty patterns"++showFilterOption :: FilterOption -> String+showFilterOption =+  unpack+    . T.intercalate ","+    . map (pack . decompile)+    . NE.toList+    . unFilterOption++defaultFilterOption :: FilterOption+defaultFilterOption = filterOptionFromPaths $ pure "**/*"++filterFilePaths :: FilterOption -> [FilePath] -> [FilePath]+filterFilePaths fo = filter $ \path -> any (`match` path) $ unFilterOption fo

@@ -0,0 +1,40 @@+module Stackctl.Options+  ( Options(..)+  , optionsParser+  ) where++import Stackctl.Prelude++import Options.Applicative+import Stackctl.ColorOption+import Stackctl.DirectoryOption+import Stackctl.FilterOption+import Stackctl.VerboseOption++data Options = Options+  { oDirectory :: FilePath+  , oFilterOption :: FilterOption+  , oColor :: LogColor+  , oVerbose :: Verbosity+  }++instance HasDirectoryOption Options where+  directoryOptionL = lens oDirectory $ \x y -> x { oDirectory = y }++instance HasColorOption Options where+  colorOptionL = lens oColor $ \x y -> x { oColor = y }++instance HasFilterOption Options where+  filterOptionL = lens oFilterOption $ \x y -> x { oFilterOption = y }++instance HasVerboseOption Options where+  verboseOptionL = lens oVerbose $ \x y -> x { oVerbose = y }++-- brittany-disable-next-binding++optionsParser :: Parser Options+optionsParser = Options+  <$> directoryOption+  <*> filterOption "specifications"+  <*> colorOption+  <*> verboseOption

@@ -0,0 +1,32 @@+module Stackctl.Prelude+  ( module X+  , decodeUtf8+  ) where++import RIO as X hiding+  ( LogLevel(..)+  , LogSource+  , logDebug+  , logDebugS+  , logError+  , logErrorS+  , logInfo+  , logInfoS+  , logOther+  , logOtherS+  , logWarn+  , logWarnS+  )++import Blammo.Logging as X+import Control.Error.Util as X (hush, note)+import Data.Aeson as X (ToJSON(..), object)+import Data.Text as X (pack, unpack)+import System.FilePath as X+  (dropExtension, takeBaseName, takeDirectory, (<.>), (</>))+import UnliftIO.Directory as X (withCurrentDirectory)++{-# ANN module ("HLint: ignore Avoid restricted qualification" :: String) #-}++decodeUtf8 :: ByteString -> Text+decodeUtf8 = decodeUtf8With lenientDecode

@@ -0,0 +1,44 @@+module Stackctl.Prompt+  ( prompt+  , promptContinue+  ) where++import Stackctl.Prelude++import Blammo.Logging.Logger (flushLogger)+import qualified Data.Text as T+import qualified Data.Text.IO as T++prompt+  :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env)+  => Text+  -- ^ Message to present+  -> (Text -> Either Text a)+  -- ^ Parse user input (stripped)+  -> (a -> m r)+  -- ^ Action to take on result+  -> m r+prompt message parse dispatch = do+  flushLogger++  x <- liftIO $ do+    T.putStr $ message <> "? "+    hFlush stdout+    T.strip <$> T.getLine++  case parse x of+    Left err -> do+      logWarn $ "Invalid input" :# ["error" .= err]+      prompt message parse dispatch+    Right a -> dispatch a++promptContinue+  :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => m ()+promptContinue = prompt "Continue (y/n)" parse dispatch+ where+  parse x+    | x `elem` ["y", "Y"] = Right True+    | x `elem` ["n", "N"] = Right False+    | otherwise = Left $ "Must be y, Y, n, or N (saw " <> x <> ")"++  dispatch b = if b then pure () else exitSuccess

@@ -0,0 +1,87 @@+module Stackctl.Spec.Capture+  ( CaptureOptions(..)+  , runCaptureOptions+  , runCapture+  ) where++import Stackctl.Prelude++import Options.Applicative+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.DirectoryOption (HasDirectoryOption(..))+import Stackctl.Spec.Generate++data CaptureOptions = CaptureOptions+  { scoAccountName :: Maybe Text+  , scoTemplatePath :: Maybe FilePath+  , scoStackPath :: Maybe FilePath+  , scoDepends :: Maybe [StackName]+  , scoStackName :: StackName+  }++-- brittany-disable-next-binding++runCaptureOptions :: Parser CaptureOptions+runCaptureOptions = CaptureOptions+    <$> optional (strOption+      (  short 'n'+      <> long "account-name"+      <> metavar "NAME"+      <> help "Account name to use in generated files"+      ))+    <*> optional (strOption+      (  short 't'+      <> long "template-path"+      <> metavar "PATH"+      <> help "Write Template to PATH. Default is based on STACK"+      ))+    <*> optional (strOption+      (  short 'p'+      <> long "path"+      <> metavar "PATH"+      <> help "Write specification to PATH. Default is based on STACK"+      ))+    <*> optional (some (StackName <$> strOption+      (  long "depend"+      <> metavar "STACK"+      <> help "Add a dependency on STACK"+      )))+    <*> (StackName <$> argument str+      (  metavar "STACK"+      <> help "Name of deployed Stack to capture"+      ))++runCapture+  :: ( MonadMask m+     , MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsScope env+     , HasAwsEnv env+     , HasDirectoryOption env+     )+  => CaptureOptions+  -> m ()+runCapture CaptureOptions {..} = do+  dir <- view directoryOptionL+  stack <- awsCloudFormationDescribeStack scoStackName+  template <- awsCloudFormationGetTemplate scoStackName++  let+    setScopeName scope =+      maybe scope (\name -> scope { awsAccountName = name }) scoAccountName++  void $ local (awsScopeL %~ setScopeName) $ generate Generate+    { gOutputDirectory = dir+    , gTemplatePath = scoTemplatePath+    , gStackPath = scoStackPath+    , gStackName = scoStackName+    , gDepends = scoDepends+    , gActions = Nothing+    , gParameters = parameters stack+    , gCapabilities = capabilities stack+    , gTags = tags stack+    , gTemplate = template+    }

@@ -0,0 +1,183 @@+module Stackctl.Spec.Cat+  ( CatOptions(..)+  , runCatOptions+  , runCat+  ) where++import Stackctl.Prelude++import Blammo.Logging.Logger (flushLogger)+import Data.Aeson+import Data.Aeson.Lens+import qualified Data.HashMap.Strict as HashMap+import Data.List (sort, sortOn)+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Yaml as Yaml+import Options.Applicative+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Colors+import Stackctl.DirectoryOption (HasDirectoryOption(..))+import Stackctl.FilterOption (HasFilterOption)+import Stackctl.Spec.Discover+import Stackctl.StackSpec+import Stackctl.StackSpecPath+import Stackctl.StackSpecYaml++data CatOptions = CatOptions+  { sctoNoStacks :: Bool+  , sctoNoTemplates :: Bool+  , sctoBrief :: Bool+  }++-- brittany-disable-next-binding++runCatOptions :: Parser CatOptions+runCatOptions = CatOptions+  <$> switch+    (  long "no-stacks"+    <> help "Only show templates/"+    )+  <*> switch+    (  long "no-templates"+    <> help "Only show stacks/"+    )+  <*> switch+    (  short 'b'+    <> long "brief"+    <> help "Don't show file contents, only paths"+    )++runCat+  :: ( MonadMask m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasLogger env+     , HasAwsScope env+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => CatOptions+  -> m ()+runCat CatOptions {..} = do+  dir <- view directoryOptionL+  colors@Colors {..} <- getColorsStdout+  tree <- specTree <$> discoverSpecs++  let+    putStack n x = if sctoNoStacks then pure () else put n x+    putStackBody n x =+      if sctoNoStacks || sctoBrief then pure () else putBoxed n x+    putTemplate n x = if sctoNoTemplates then pure () else put n x+    putTemplateBody n x =+      if sctoNoTemplates || sctoBrief then pure () else putBoxed n x++  flushLogger++  put 0 $ fromString dir <> "/"+  putStack 2 "stacks/"+  templates <- for tree $ \((accountId, accountName), regions) -> do+    putStack 4 $ magenta (unAccountId accountId) <> "." <> accountName <> "/"++    for regions $ \(region, specs) -> do+      putStack 6 $ magenta (toText region) <> "/"++      let sorted = sortOn (stackSpecPathBasePath . stackSpecSpecPath) specs+      for sorted $ \spec -> do+        let+          base = stackSpecPathBasePath $ stackSpecSpecPath spec+          body = stackSpecSpecBody spec+          name = stackSpecStackName spec+          yaml = prettyPrintStackSpecYaml colors name body++        putStack 8 $ magenta (fromString base)+        putStackBody 10 yaml+        pure $ ssyTemplate body++  putTemplate 2 "templates/"+  for_ (sort $ concat $ concat templates) $ \template -> do+    val <- Yaml.decodeFileThrow @_ @Value $ dir </> "templates" </> template++    putTemplate 4 $ green $ fromString template+    putTemplateBody 6 $ prettyPrintTemplate colors val++specTree :: [StackSpec] -> [((AccountId, Text), [(Region, [StackSpec])])]+specTree = map (second groupRegion) . groupAccount+ where+  groupRegion :: [StackSpec] -> [(Region, [StackSpec])]+  groupRegion = groupTo (stackSpecPathRegion . stackSpecSpecPath)++  groupAccount :: [StackSpec] -> [((AccountId, Text), [StackSpec])]+  groupAccount = groupTo+    ((stackSpecPathAccountId &&& stackSpecPathAccountName) . stackSpecSpecPath)++groupTo :: Ord b => (a -> b) -> [a] -> [(b, [a])]+groupTo f = map (f . NE.head &&& NE.toList) . NE.groupAllWith f++prettyPrintStackSpecYaml :: Colors -> StackName -> StackSpecYaml -> [Text]+prettyPrintStackSpecYaml Colors {..} name StackSpecYaml {..} = concat+  [ [cyan "Name" <> ": " <> green (unStackName name)]+  , [cyan "Template" <> ": " <> green (pack ssyTemplate)]+  , ppList "Parameters" (ppParameters . map unParameterYaml) ssyParameters+  , ppList "Capabilities" ppCapabilities ssyCapabilities+  , ppList "Tags" (ppTags . map unTagYaml) ssyTags+  ]+ where+  ppList :: Text -> (a -> [Text]) -> Maybe a -> [Text]+  ppList label f = maybe [] (((cyan label <> ":") :) . f)++  ppParameters = concatMap $ \p ->+    [ "  - " <> cyan "ParameterKey" <> ": " <> maybe+      ""+      green+      (p ^. parameter_parameterKey)+    , "    " <> cyan "ParameterValue" <> ": " <> maybe+      ""+      toText+      (p ^. parameter_parameterValue)+    ]++  ppCapabilities = map (("  - " <>) . green . toText)++  ppTags = concatMap $ \tg ->+    [ "  - " <> cyan "Key" <> ": " <> green (tg ^. tag_key)+    , "    " <> cyan "Value" <> ": " <> (tg ^. tag_value)+    ]++prettyPrintTemplate :: Colors -> Value -> [Text]+prettyPrintTemplate Colors {..} val = concat+  [ displayTextProperty "Description"+  , displayObjectProperty "Parameters"+  , displayObjectProperty "Resources"+  , displayObjectProperty "Outputs"+  ]+ where+  displayTextProperty :: Text -> [Text]+  displayTextProperty = displayPropertyWith+    $ \v -> let tp = T.dropWhileEnd (== '\n') $ pack v in ["  " <> green tp]++  displayObjectProperty :: Text -> [Text]+  displayObjectProperty =+    displayPropertyWith @(HashMap Text Value)+      $ map (("  - " <>) . green)+      . sort+      . HashMap.keys++  displayPropertyWith+    :: (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]+  displayPropertyWith f k = cyan k <> ": " : fromMaybe [] displayValue+    where displayValue = val ^? key k . _JSON . to f++putBoxed :: MonadIO m => Int -> [Text] -> m ()+putBoxed n xs = do+  traverse_ (put n . ("│ " <>)) xs+  put n "└──────────"+  put 0 ""++put :: MonadIO m => Int -> Text -> m ()+put n = liftIO . T.putStrLn . (indent <>)+  where indent = mconcat $ replicate n " "

@@ -0,0 +1,68 @@+module Stackctl.Spec.Changes+  ( ChangesOptions(..)+  , runChangesOptions+  , runChanges+  ) where++import Stackctl.Prelude++import qualified Data.Text.IO as T+import Options.Applicative+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Colors+import Stackctl.DirectoryOption (HasDirectoryOption)+import Stackctl.FilterOption (HasFilterOption)+import Stackctl.Spec.Changes.Format+import Stackctl.Spec.Discover+import Stackctl.StackSpec+import Stackctl.StackSpecPath++data ChangesOptions = ChangesOptions+  { scoFormat :: Format+  , scoOutput :: FilePath+  }++-- brittany-disable-next-binding++runChangesOptions :: Parser ChangesOptions+runChangesOptions = ChangesOptions+  <$> formatOption+  <*> argument str+    (  metavar "PATH"+    <> help "Where to write the changes summary"+    )++runChanges+  :: ( MonadMask m+     , MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsScope env+     , HasAwsEnv env+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => ChangesOptions+  -> m ()+runChanges ChangesOptions {..} = do+  specs <- discoverSpecs++  for_ specs $ \spec -> do+    withThreadContext ["stackName" .= stackSpecStackName spec] $ do+      emChangeSet <- createChangeSet spec++      case emChangeSet of+        Left err -> do+          logError $ "Error creating ChangeSet" :# ["error" .= err]+          exitFailure+        Right mChangeSet -> do+          colors <- getColorsStdout+          let name = pack $ stackSpecPathFilePath $ stackSpecSpecPath spec+          liftIO $ T.writeFile scoOutput $ formatChangeSet+            colors+            name+            scoFormat+            mChangeSet

@@ -0,0 +1,172 @@+module Stackctl.Spec.Changes.Format+  ( Format(..)+  , formatOption+  , formatChangeSet+  , formatTTY+  ) where++import Stackctl.Prelude++import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Options.Applicative hiding (action)+import Stackctl.AWS+import Stackctl.Colors++data Format+  = FormatTTY+  | FormatPullRequest++formatOption :: Parser Format+formatOption = option (eitherReader readFormat) $ mconcat+  [ short 'f'+  , long "format"+  , help "Format to output changes in"+  , value FormatTTY+  , showDefaultWith showFormat+  ]++readFormat :: String -> Either String Format+readFormat = \case+  "tty" -> Right FormatTTY+  "pr" -> Right FormatPullRequest+  x -> Left $ "Invalid format: " <> x++showFormat :: Format -> String+showFormat = \case+  FormatTTY -> "tty"+  FormatPullRequest -> "pr"++formatChangeSet :: Colors -> Text -> Format -> Maybe ChangeSet -> Text+formatChangeSet colors name = \case+  FormatTTY -> formatTTY colors name+  FormatPullRequest -> formatPullRequest name++formatTTY :: Colors -> Text -> Maybe ChangeSet -> Text+formatTTY colors@Colors {..} name mChangeSet = case (mChangeSet, rChanges) of+  (Nothing, _) -> "No changes for " <> name+  (_, Nothing) -> "Metadata only changes (e.g. Tags or Outputs)"+  (_, Just rcs) ->+    ("\n" <>) $ (<> "\n") $ mconcat $ ("Changes for " <> cyan name <> ":") : map+      (("\n  " <>) . formatResourceChange)+      (NE.toList rcs)+ where+  rChanges = do+    cs <- mChangeSet+    changes <- csChanges cs+    NE.nonEmpty $ mapMaybe resourceChange changes++  formatResourceChange ResourceChange' {..} =+    maybe "" colorAction action+      <> " "+      <> maybe "" toText logicalResourceId+      <> " ("+      <> maybe "" cyan resourceType+      <> ")"+      <> maybe "" ((" " <>) . magenta) physicalResourceId+      <> maybe "" (("\n    Replacement: " <>) . colorReplacement) replacement+      <> maybe "" (("\n    Scope: " <>) . T.intercalate ", " . map toText) scope+      <> maybe "" (("\n    Details:" <>) . formatDetails) details++  formatDetails =+    mconcat . map ("\n      * " <>) . mapMaybe (formatDetail colors)++  colorAction = \case+    x@ChangeAction_Add -> green (toText x)+    x@ChangeAction_Modify -> yellow (toText x)+    x@ChangeAction_Remove -> red (toText x)+    ChangeAction' x -> x++  colorReplacement = \case+    x@Replacement_True -> red (toText x)+    x@Replacement_False -> green (toText x)+    x@Replacement_Conditional -> yellow (toText x)+    Replacement' x -> x++formatPullRequest :: Text -> Maybe ChangeSet -> Text+formatPullRequest name mChangeSet =+  emoji+    <> " This PR generates "+    <> description+    <> " for `"+    <> name+    <> "`."+    <> fromMaybe "" (commentBody <$> mChangeSet <*> rChanges)+    <> "\n"+ where+  emoji = case (mChangeSet, nChanges) of+    (Nothing, _) -> ":heavy_check_mark:"+    (_, Nothing) -> ":book:"+    (_, Just _) -> ":warning:"++  description = case (mChangeSet, nChanges) of+    (Nothing, _) -> "no changes"+    (_, Nothing) -> "only metadata changes (Tags, Outputs, etc)"+    (_, Just 1) -> "**1** change"+    (_, Just n) -> "**" <> pack (show n) <> "** changes"++  nChanges = length <$> rChanges++  rChanges = do+    cs <- mChangeSet+    changes <- csChanges cs+    NE.nonEmpty $ mapMaybe resourceChange changes++commentBody :: ChangeSet -> NonEmpty ResourceChange -> Text+commentBody cs rcs =+  mconcat+    $ [ "\n"+      , "\n| Action | Logical Id | Physical Id | Type | Replacement | Scope | Details |"+      , "\n| ---    | ---        | ---         | ---  | ---         | ---   | ---     |"+      ]+    <> map commentTableRow (NE.toList rcs)+    <> [ "\n"+       , "\n<details>"+       , "\n<summary>Full changes</summary>"+       , "\n"+       , "\n```json"+       , "\n" <> changeSetJSON cs+       , "\n```"+       , "\n"+       , "\n</details>"+       ]++commentTableRow :: ResourceChange -> Text+commentTableRow ResourceChange' {..} = mconcat+  [ "\n"+  , "| " <> maybe "" toText action <> " "+  , "| " <> maybe "" toText logicalResourceId <> " "+  , "| " <> maybe "" toText physicalResourceId <> " "+  , "| " <> maybe "" toText resourceType <> " "+  , "| " <> maybe "" toText replacement <> " "+  , "| " <> maybe "" (T.intercalate ", " . map toText) scope <> " "+  , "| " <> maybe "" (mdList . mapMaybe (formatDetail noColors)) details <> " "+  , "|"+  ]++mdList :: [Text] -> Text+mdList xs =+  "<ul>" <> mconcat (map (\x -> "<li>" <> x <> "</li>") xs) <> "</ul>"++formatDetail :: Colors -> ResourceChangeDetail -> Maybe Text+formatDetail Colors {..} ResourceChangeDetail' {..} = do+  c <- changeSource+  t <- target++  let+    attr = attribute t+    n = name t+    rr = requiresRecreation t++  pure+    $ toText c+    <> maybe "" ((" in " <>) . toText) attr+    <> maybe "" (\x -> " (" <> magenta (toText x) <> ")") n+    <> maybe "" ((", recreation " <>) . formatRR) rr+    <> maybe "" ((", caused by " <>) . toText) causingEntity+ where+  formatRR = \case+    x@RequiresRecreation_Always -> red (toText x)+    x@RequiresRecreation_Never -> green (toText x)+    x@RequiresRecreation_Conditionally -> yellow (toText x)+    RequiresRecreation' x -> x

@@ -0,0 +1,232 @@+module Stackctl.Spec.Deploy+  ( DeployOptions(..)+  , DeployConfirmation(..)+  , runDeployOptions+  , runDeploy+  ) where++import Stackctl.Prelude++import Blammo.Logging.Logger (pushLogStrLn)+import qualified Data.Text as T+import Data.Time (defaultTimeLocale, formatTime, utcToLocalZonedTime)+import Options.Applicative+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Action+import Stackctl.Colors+import Stackctl.DirectoryOption (HasDirectoryOption)+import Stackctl.FilterOption (HasFilterOption)+import Stackctl.Prompt+import Stackctl.Spec.Changes.Format+import Stackctl.Spec.Discover+import Stackctl.StackSpec+import System.Log.FastLogger (toLogStr)+import UnliftIO.Directory (createDirectoryIfMissing)++data DeployOptions = DeployOptions+  { sdoSaveChangeSets :: Maybe FilePath+  , sdoDeployConfirmation :: DeployConfirmation+  , sdoClean :: Bool+  }++-- brittany-disable-next-binding++runDeployOptions :: Parser DeployOptions+runDeployOptions = DeployOptions+  <$> optional (strOption+    (  long "save-change-sets"+    <> metavar "DIRECTORY"+    <> help "Save executed changesets to DIRECTORY"+    ))+  <*> flag DeployWithConfirmation DeployWithoutConfirmation+    (  long "no-confirm"+    <> help "Don't confirm changes before executing"+    )+  <*> switch+    (  long "clean"+    <> help "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+     , HasDirectoryOption env+     , HasFilterOption env+     , HasColorOption env+     )+  => DeployOptions+  -> m ()+runDeploy DeployOptions {..} = do+  specs <- discoverSpecs++  for_ specs $ \spec -> do+    withThreadContext ["stackName" .= stackSpecStackName spec] $ do+      handleRollbackComplete sdoDeployConfirmation $ stackSpecStackName spec++      emChangeSet <- createChangeSet spec++      case emChangeSet of+        Left err -> do+          logError $ "Error creating ChangeSet" :# ["error" .= err]+          exitFailure+        Right Nothing -> logInfo "Stack is up to date"+        Right (Just changeSet) -> do+          let stackName = stackSpecStackName spec++          for_ sdoSaveChangeSets $ \dir -> do+            let out = dir </> unpack (unStackName stackName) <.> "json"+            logInfo $ "Recording changeset" :# ["path" .= out]+            createDirectoryIfMissing True dir+            writeFileUtf8 out $ changeSetJSON changeSet++          deployChangeSet sdoDeployConfirmation changeSet+          runActions stackName PostDeploy $ stackSpecActions spec+          when sdoClean $ awsCloudFormationDeleteAllChangeSets stackName++data DeployConfirmation+  = DeployWithConfirmation+  | DeployWithoutConfirmation+  deriving stock Eq++handleRollbackComplete+  :: ( MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasLogger env+     , HasAwsEnv env+     )+  => DeployConfirmation+  -> StackName+  -> m ()+handleRollbackComplete confirmation stackName = do+  mStack <- awsCloudFormationDescribeStackMaybe stackName++  when (maybe False stackIsRollbackComplete mStack) $ do+    logWarn+      $ "Stack is in ROLLBACK_COMPLETE state and must be deleted before proceeding"+      :# ["stackName" .= stackName]++    case confirmation of+      DeployWithConfirmation -> promptContinue+      DeployWithoutConfirmation -> do+        logError "Refusing to delete without confirmation"+        exitFailure++    result <- awsCloudFormationDeleteStack stackName++    case result of+      StackDeleteSuccess -> logInfo $ prettyStackDeleteResult result :# []+      StackDeleteFailure{} -> logWarn $ prettyStackDeleteResult result :# []++deployChangeSet+  :: ( MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasLogger env+     , HasAwsEnv env+     , HasColorOption env+     )+  => DeployConfirmation+  -> ChangeSet+  -> m ()+deployChangeSet confirmation changeSet = do+  colors <- getColorsStdout++  pushLogger $ formatTTY colors (unStackName stackName) $ Just changeSet++  case confirmation of+    DeployWithConfirmation -> promptContinue+    DeployWithoutConfirmation -> pure ()++  -- It can take a minute to get this batch of events to work out where we're+  -- tailing from, so do that part synchronously+  mLastId <- awsCloudFormationGetMostRecentStackEventId stackName+  asyncTail <- async $ tailStackEventsSince stackName mLastId++  logInfo $ "Executing ChangeSet" :# ["changeSetId" .= changeSetId]+  result <- do+    awsCloudFormationExecuteChangeSet changeSetId+    awsCloudFormationWait stackName++  cancel asyncTail++  let+    onSuccess = logInfo $ prettyStackDeployResult result :# []+    onFailure = do+      logError $ prettyStackDeployResult result :# []+      exitFailure++  case result of+    StackCreateSuccess -> onSuccess+    StackCreateFailure{} -> onFailure+    StackUpdateSuccess -> onSuccess+    StackUpdateFailure{} -> onFailure+ where+  stackName = csStackName changeSet+  changeSetId = csChangeSetId changeSet++tailStackEventsSince+  :: ( MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasLogger env+     , HasAwsEnv env+     , HasColorOption env+     )+  => StackName+  -> Maybe Text -- ^ StackEventId+  -> m a+tailStackEventsSince stackName mLastId = do+  colors <- getColorsStdout+  events <- awsCloudFormationDescribeStackEvents stackName mLastId+  traverse_ (pushLogger <=< formatStackEvent colors) $ reverse events++  -- Without this small delay before looping, our requests seem to hang+  -- intermittently (without errors) and often we miss events.+  threadDelay $ 1 * 1000000++  -- Tail from the next "last id". If we got no events, be sure to pass along+  -- any last-id we were given+  tailStackEventsSince stackName $ getLastEventId events <|> mLastId++formatStackEvent :: MonadIO m => Colors -> StackEvent -> m Text+formatStackEvent Colors {..} e = do+  timestamp <-+    liftIO $ formatTime defaultTimeLocale "%F %T %Z" <$> utcToLocalZonedTime+      (e ^. stackEvent_timestamp)++  pure $ mconcat+    [ fromString timestamp+    , " | "+    , maybe "" colorStatus $ e ^. stackEvent_resourceStatus+    , maybe "" (magenta . (" " <>)) $ e ^. stackEvent_logicalResourceId+    , maybe "" ((\x -> " (" <> x <> ")") . T.strip)+    $ e+    ^. stackEvent_resourceStatusReason+    ]+ where+  colorStatus = \case+    ResourceStatus' x+      | "ROLLBACK" `T.isInfixOf` x -> red x+      | "COMPLETE" `T.isSuffixOf` x -> green x+      | "FAILED" `T.isSuffixOf` x -> red x+      | "IN_PROGRESS" `T.isSuffixOf` x -> blue x+      | "SKIPPED" `T.isSuffixOf` x -> yellow x+      | otherwise -> x++getLastEventId :: [StackEvent] -> Maybe Text+getLastEventId = fmap (^. stackEvent_eventId) . listToMaybe++pushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => Text -> m ()+pushLogger msg = do+  logger <- view loggerL+  pushLogStrLn logger $ toLogStr msg

@@ -0,0 +1,107 @@+module Stackctl.Spec.Discover+  ( discoverSpecs+  , buildSpecPath+  ) where++import Stackctl.Prelude++import Data.List.Extra (dropPrefix)+import qualified Data.List.NonEmpty as NE+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.DirectoryOption (HasDirectoryOption(..))+import Stackctl.FilterOption (HasFilterOption(..), filterFilePaths)+import Stackctl.StackSpec+import Stackctl.StackSpecPath+import System.FilePath (isPathSeparator)+import System.FilePath.Glob++discoverSpecs+  :: ( MonadMask m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsScope env+     , HasDirectoryOption env+     , HasFilterOption env+     )+  => m [StackSpec]+discoverSpecs = do+  dir <- view directoryOptionL+  scope@AwsScope {..} <- view awsScopeL+  discovered <- globRelativeTo+    dir+    [ compile+    $ "stacks"+    </> unpack (unAccountId awsAccountId)+    <> ".*"+    </> unpack (fromRegion awsRegion)+    <> "**"+    </> "*"+    <.> "yaml"+    , compile+    $ "stacks"+    </> "*."+    <> unpack (unAccountId awsAccountId)+    </> unpack (fromRegion awsRegion)+    <> "**"+    </> "*"+    <.> "yaml"+    ]++  filterOption <- view filterOptionL++  let+    filtered = filterFilePaths filterOption discovered+    toSpecPath = stackSpecPathFromFilePath scope+    (errs, specPaths) = partitionEithers $ map toSpecPath filtered++    context =+      [ "path" .= dir+      , "filters" .= filterOption+      , "discovered" .= length discovered+      , "filtered" .= length filtered+      , "errors" .= length errs+      ]++  withThreadContext context $ do+    logDebug "Discovered specs"+    when (null filtered) $ logWarn "No specs found"+    checkForDuplicateStackNames specPaths++  sortStackSpecs <$> traverse (readStackSpec dir) specPaths++checkForDuplicateStackNames+  :: (MonadIO m, MonadLogger m) => [StackSpecPath] -> m ()+checkForDuplicateStackNames =+  traverse_ reportCollisions+    . NE.nonEmpty+    . filter ((> 1) . length)+    . NE.groupAllWith stackSpecPathStackName+ where+  reportCollisions+    :: (MonadIO m, MonadLogger m) => NonEmpty (NonEmpty StackSpecPath) -> m ()+  reportCollisions errs = do+    for_ errs $ \specPaths -> do+      let collidingPaths = stackSpecPathBasePath <$> specPaths++      logError+        $ "Multiple specifications produced the same Stack name"+        :# [ "name" .= stackSpecPathStackName (NE.head specPaths)+           , "paths" .= collidingPaths+           ]++    exitFailure++buildSpecPath+  :: (MonadReader env m, HasAwsScope env)+  => StackName+  -> FilePath+  -> m StackSpecPath+buildSpecPath stackName stackPath = do+  scope <- view awsScopeL+  pure $ stackSpecPath scope stackName stackPath++globRelativeTo :: MonadIO m => FilePath -> [Pattern] -> m [FilePath]+globRelativeTo dir ps = liftIO $ do+  map (dropWhile isPathSeparator . dropPrefix dir) . concat <$> globDir ps dir

@@ -0,0 +1,64 @@+module Stackctl.Spec.Generate+  ( Generate(..)+  , generate+  ) where++import Stackctl.Prelude++import Data.Aeson+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Action+import Stackctl.Spec.Discover (buildSpecPath)+import Stackctl.StackSpec+import Stackctl.StackSpecPath+import Stackctl.StackSpecYaml++data Generate = Generate+  { gOutputDirectory :: FilePath+  , gTemplatePath :: Maybe FilePath+  -- ^ If not given will use @{stack-name}.yaml@+  , gStackPath :: Maybe FilePath+  -- ^ If not given will use @{stack-name}.yaml@+  , gStackName :: StackName+  , gDepends :: Maybe [StackName]+  , gActions :: Maybe [Action]+  , gParameters :: Maybe [Parameter]+  , gCapabilities :: Maybe [Capability]+  , gTags :: Maybe [Tag]+  , gTemplate :: Value+  }++generate+  :: ( MonadMask m+     , MonadUnliftIO m+     , MonadLogger m+     , MonadReader env m+     , HasAwsScope env+     )+  => Generate+  -> m FilePath+generate Generate {..} = do+  let+    path = unpack (unStackName gStackName) <.> "yaml"+    stackPath = fromMaybe path gStackPath++  specPath <- buildSpecPath gStackName stackPath++  let+    templatePath = fromMaybe path gTemplatePath+    specYaml = StackSpecYaml+      { ssyTemplate = templatePath+      , ssyDepends = gDepends+      , ssyActions = gActions+      , ssyParameters = map ParameterYaml <$> gParameters+      , ssyCapabilities = gCapabilities+      , ssyTags = map TagYaml <$> gTags+      }++    stackSpec = buildStackSpec gOutputDirectory specPath specYaml++  withThreadContext ["stackName" .= stackSpecStackName stackSpec] $ do+    logInfo "Generating specification"+    writeStackSpec gOutputDirectory stackSpec gTemplate+    pure $ stackSpecPathFilePath specPath

@@ -0,0 +1,131 @@+module Stackctl.StackSpec+  ( StackSpec+  , stackSpecSpecPath+  , stackSpecSpecBody+  , stackSpecStackName+  , stackSpecActions+  , stackSpecParameters+  , stackSpecCapabilities+  , stackSpecTags+  , buildStackSpec+  , writeStackSpec+  , readStackSpec+  , createChangeSet+  , sortStackSpecs+  ) where++import Stackctl.Prelude++import qualified CfnFlip+import Data.Aeson+import Data.Graph (graphFromEdges, topSort)+import qualified Data.Yaml as Yaml+import Stackctl.AWS+import Stackctl.Action+import Stackctl.StackSpecPath+import Stackctl.StackSpecYaml+import UnliftIO.Directory (createDirectoryIfMissing)++data StackSpec = StackSpec+  { ssSpecRoot :: FilePath+  , ssSpecPath :: StackSpecPath+  , ssSpecBody :: StackSpecYaml+  }++stackSpecSpecPath :: StackSpec -> StackSpecPath+stackSpecSpecPath = ssSpecPath++stackSpecSpecBody :: StackSpec -> StackSpecYaml+stackSpecSpecBody = ssSpecBody++stackSpecStackName :: StackSpec -> StackName+stackSpecStackName = stackSpecPathStackName . ssSpecPath++stackSpecDepends :: StackSpec -> [StackName]+stackSpecDepends = fromMaybe [] . ssyDepends . ssSpecBody++stackSpecActions :: StackSpec -> [Action]+stackSpecActions = fromMaybe [] . ssyActions . ssSpecBody++stackSpecTemplateFile :: StackSpec -> StackTemplate+stackSpecTemplateFile StackSpec {..} =+  StackTemplate $ ssSpecRoot </> "templates" </> ssyTemplate ssSpecBody++stackSpecParameters :: StackSpec -> [Parameter]+stackSpecParameters =+  maybe [] (map unParameterYaml) . ssyParameters . ssSpecBody++stackSpecCapabilities :: StackSpec -> [Capability]+stackSpecCapabilities = fromMaybe [] . ssyCapabilities . ssSpecBody++stackSpecTags :: StackSpec -> [Tag]+stackSpecTags = maybe [] (map unTagYaml) . ssyTags . ssSpecBody++buildStackSpec :: FilePath -> StackSpecPath -> StackSpecYaml -> StackSpec+buildStackSpec = StackSpec++writeStackSpec+  :: MonadUnliftIO m+  => FilePath -- ^ Parent directory+  -> StackSpec+  -> Value -- ^ Template body+  -> m ()+writeStackSpec parent stackSpec@StackSpec {..} templateBody = do+  createDirectoryIfMissing True $ takeDirectory templatePath++  case templateBody of+    -- Already Yaml+    String x -> writeFileUtf8 templatePath x+    _ -> CfnFlip.jsonToYamlFile templatePath templateBody++  createDirectoryIfMissing True $ takeDirectory specPath+  liftIO $ Yaml.encodeFile specPath ssSpecBody+ where+  templatePath = unStackTemplate $ stackSpecTemplateFile stackSpec+  specPath = parent </> stackSpecPathFilePath ssSpecPath++readStackSpec :: MonadIO m => FilePath -> StackSpecPath -> m StackSpec+readStackSpec dir specPath = do+  specBody <- liftIO $ either err pure =<< Yaml.decodeFileEither path++  pure StackSpec+    { ssSpecRoot = dir+    , ssSpecPath = specPath+    , ssSpecBody = specBody+    }+ where+  path = dir </> stackSpecPathFilePath specPath+  err e =+    throwString $ path <> " is invalid: " <> Yaml.prettyPrintParseException e++-- | Create a Change Set between a Stack Specification and deployed state+--+-- We use @aws cloudformation deploy --no-execute-changeset@ because it handles+-- the create-or-update logic for us.+--+createChangeSet+  :: ( MonadUnliftIO m+     , MonadResource m+     , MonadLogger m+     , MonadReader env m+     , HasAwsEnv env+     )+  => StackSpec+  -> m (Either Text (Maybe ChangeSet))+createChangeSet spec = awsCloudFormationCreateChangeSet+  (stackSpecStackName spec)+  (stackSpecTemplateFile spec)+  (stackSpecParameters spec)+  (stackSpecCapabilities spec)+  (stackSpecTags spec)++sortStackSpecs :: [StackSpec] -> [StackSpec]+sortStackSpecs specs = map nodeFromVertex $ reverse $ topSort graph+ where+  (graph, tripleFromVertex, _) = graphFromEdges $ map tripleFromNode specs++  nodeFromVertex = nodeFromTriple . tripleFromVertex++  tripleFromNode n = (n, stackSpecStackName n, stackSpecDepends n)++  nodeFromTriple (n, _, _) = n

@@ -0,0 +1,118 @@+{-# LANGUAGE NamedFieldPuns #-}++module Stackctl.StackSpecPath+  ( StackSpecPath++  -- * Fields+  , stackSpecPathAccountId+  , stackSpecPathAccountName+  , stackSpecPathRegion+  , stackSpecPathStackName+  , stackSpecPathBasePath+  , stackSpecPathFilePath++  -- * Construction+  , stackSpecPath+  , stackSpecPathFromFilePath+  ) where++import Stackctl.Prelude++import Data.Char (isDigit)+import qualified Data.Text as T+import Stackctl.AWS+import Stackctl.AWS.Scope+import System.FilePath (joinPath, splitDirectories)++data StackSpecPath = StackSpecPath+  { sspAwsScope :: AwsScope+  , sspAccountPathPart :: FilePath+  , sspStackName :: StackName+  , sspPath :: FilePath+  }++stackSpecPath :: AwsScope -> StackName -> FilePath -> StackSpecPath+stackSpecPath sspAwsScope@AwsScope {..} sspStackName sspPath = StackSpecPath+  { sspAwsScope+  , sspAccountPathPart+  , sspStackName+  , sspPath+  }+ where+  sspAccountPathPart =+    unpack $ unAccountId awsAccountId <> "." <> awsAccountName++stackSpecPathAccountId :: StackSpecPath -> AccountId+stackSpecPathAccountId = awsAccountId . sspAwsScope++stackSpecPathAccountName :: StackSpecPath -> Text+stackSpecPathAccountName = awsAccountName . sspAwsScope++stackSpecPathAccountPathPart :: StackSpecPath -> FilePath+stackSpecPathAccountPathPart = sspAccountPathPart++stackSpecPathRegion :: StackSpecPath -> Region+stackSpecPathRegion = awsRegion . sspAwsScope++stackSpecPathBasePath :: StackSpecPath -> FilePath+stackSpecPathBasePath = sspPath++stackSpecPathStackName :: StackSpecPath -> StackName+stackSpecPathStackName = sspStackName++-- | Render the (relative) 'StackSpecPath'+stackSpecPathFilePath :: StackSpecPath -> FilePath+stackSpecPathFilePath path =+  "stacks"+    </> stackSpecPathAccountPathPart path+    </> unpack (fromRegion $ stackSpecPathRegion path)+    </> stackSpecPathBasePath path++stackSpecPathFromFilePath+  :: AwsScope+  -> FilePath -- ^ Must be relative, @stacks/@+  -> Either String StackSpecPath+stackSpecPathFromFilePath awsScope@AwsScope {..} path =+  case splitDirectories path of+    ("stacks" : pathAccount : pathRegion : rest) -> do+      (accountName, pathAccountId) <- parseAccountPath pathAccount++      unless (pathAccountId == awsAccountId)+        $ Left+        $ "Unexpected account: "+        <> unpack (unAccountId pathAccountId)+        <> " != "+        <> unpack (unAccountId awsAccountId)++      unless (unpack (fromRegion awsRegion) == pathRegion)+        $ Left+        $ "Unexpected region: "+        <> pathRegion+        <> " != "+        <> unpack (fromRegion awsRegion)++      stackName <-+        maybe (Left "Must end in .yaml") (Right . StackName)+        $ T.stripSuffix ".yaml"+        $ T.intercalate "-"+        $ map pack rest++      Right $ StackSpecPath+        { sspAwsScope = awsScope { awsAccountName = accountName }+        , sspAccountPathPart = pathAccount+        , sspStackName = stackName+        , sspPath = joinPath rest+        }++    _ -> Left $ "Path is not stacks/././.: " <> path++-- | Handle @{account-name}.{account-id}@ or @{account-id}.{account-name}@+parseAccountPath :: FilePath -> Either String (Text, AccountId)+parseAccountPath path = case second (T.drop 1) $ T.breakOn "." $ pack path of+  (a, b) | isAccountId a -> Right (b, AccountId a)+  (a, b) | isAccountId b -> Right (a, AccountId b)+  _ ->+    Left+      $ "Path matches neither {account-id}.{account-name}, nor {account-name}.{account-id}: "+      <> path+  where isAccountId x = T.length x == 12 && T.all isDigit x

@@ -0,0 +1,100 @@+-- | Definition of our @stacks/<account>/<region>/<stack-name>.yaml@ format+--+-- @+-- Template: <path>+--+-- Depends:+-- - <string>+--+-- Parameters:+-- - ParameterKey: <string>+--   ParameterValue: <string>+--+-- Capabilities:+-- - <capability>+--+-- Tags:+-- - Key: <string>+--   Value: <string>+-- @+--+module Stackctl.StackSpecYaml+  ( StackSpecYaml(..)+  , ParameterYaml(..)+  , TagYaml(..)+  ) where++import Stackctl.Prelude++import Data.Aeson+import Data.Aeson.Casing+import qualified Data.Text as T+import Stackctl.AWS+import Stackctl.Action++data StackSpecYaml = StackSpecYaml+  { ssyTemplate :: FilePath+  , ssyDepends :: Maybe [StackName]+  , ssyActions :: Maybe [Action]+  , ssyParameters :: Maybe [ParameterYaml]+  , ssyCapabilities :: Maybe [Capability]+  , ssyTags :: Maybe [TagYaml]+  }+  deriving stock Generic++instance FromJSON StackSpecYaml where+  parseJSON = genericParseJSON $ aesonPrefix id++instance ToJSON StackSpecYaml where+  toJSON = genericToJSON $ aesonPrefix id+  toEncoding = genericToEncoding $ aesonPrefix id++newtype ParameterYaml = ParameterYaml+  { unParameterYaml :: Parameter+  }++instance FromJSON ParameterYaml where+  parseJSON = withObject "Parameter" $ \o ->+    (build <$> o .: "Name" <*> o .: "Value")+      <|> (build <$> o .: "ParameterKey" <*> o .: "ParameterValue")+   where+    build k v = ParameterYaml $ makeParameter k $ Just $ unParameterValue v++newtype ParameterValue = ParameterValue+  { unParameterValue :: Text+  }++instance FromJSON ParameterValue where+  parseJSON = \case+    String x -> pure $ ParameterValue x+    Number x -> pure $ ParameterValue $ dropSuffix ".0" $ pack $ show x+    x -> fail $ "Expected String or Number, got: " <> show x++instance ToJSON ParameterYaml where+  toJSON = object . parameterPairs+  toEncoding = pairs . mconcat . parameterPairs++parameterPairs :: KeyValue a => ParameterYaml -> [a]+parameterPairs (ParameterYaml p) = fromMaybe [] $ do+  k <- p ^. parameter_parameterKey+  v <- p ^. parameter_parameterValue+  pure ["ParameterKey" .= k, "ParameterValue" .= v]++newtype TagYaml = TagYaml+  { unTagYaml :: Tag+  }++instance FromJSON TagYaml where+  parseJSON = withObject "Tag" $ \o -> do+    t <- newTag <$> o .: "Key" <*> o .: "Value"+    pure $ TagYaml t++instance ToJSON TagYaml where+  toJSON = object . tagPairs+  toEncoding = pairs . mconcat . tagPairs++tagPairs :: KeyValue a => TagYaml -> [a]+tagPairs (TagYaml t) = ["Key" .= (t ^. tag_key), "Value" .= (t ^. tag_value)]++dropSuffix :: Text -> Text -> Text+dropSuffix suffix t = fromMaybe t $ T.stripSuffix suffix t

@@ -0,0 +1,41 @@+module Stackctl.Subcommand+  ( Subcommand(..)+  , subcommand+  , runSubcommand+  , runSubcommand'+  ) where++import Stackctl.Prelude++import Options.Applicative+import qualified Stackctl.CLI as CLI+import Stackctl.Colors+import Stackctl.Options+import Stackctl.VerboseOption++data Subcommand options env = Subcommand+  { name :: Text+  , description :: Text+  , parse :: Parser options+  , run :: options -> CLI.AppT env IO ()+  }++subcommand :: Subcommand options env -> Mod CommandFields (CLI.AppT env IO ())+subcommand Subcommand {..} =+  command (unpack name) (run <$> withInfo description parse)++runSubcommand :: Mod CommandFields (CLI.AppT (CLI.App Options) IO ()) -> IO ()+runSubcommand = runSubcommand' "Work with Stack specifications" optionsParser++runSubcommand'+  :: (HasVerboseOption options, HasColorOption options)+  => Text+  -> Parser options+  -> Mod CommandFields (CLI.AppT (CLI.App options) IO ())+  -> IO ()+runSubcommand' x op sp = do+  (options, act) <- execParser $ withInfo x $ (,) <$> op <*> subparser sp+  CLI.runAppT options act++withInfo :: Text -> Parser a -> ParserInfo a+withInfo d p = info (p <**> helper) $ progDesc (unpack d) <> fullDesc

@@ -0,0 +1,37 @@+module Stackctl.VerboseOption+  ( Verbosity+  , verbositySetLogLevels+  , HasVerboseOption(..)+  , verboseOption+  ) where++import Stackctl.Prelude++import Blammo.Logging.LogSettings.LogLevels+import Options.Applicative++newtype Verbosity = Verbosity [()]++verbositySetLogLevels :: Verbosity -> (LogSettings -> LogSettings)+verbositySetLogLevels (Verbosity bs) = case bs of+  [] -> id+  [_] -> setLogSettingsLevels v+  [_, _] -> setLogSettingsLevels vv+  _ -> setLogSettingsLevels vvv+ where+  v = newLogLevels LevelDebug [("Amazonka", LevelInfo)]+  vv = newLogLevels LevelDebug []+  vvv = newLogLevels (LevelOther "trace") []++class HasVerboseOption env where+  verboseOptionL :: Lens' env Verbosity++instance HasVerboseOption Verbosity where+  verboseOptionL = id++verboseOption :: Parser Verbosity+verboseOption = fmap Verbosity $ many $ flag' () $ mconcat+  [ short 'v'+  , long "verbose"+  , help "Increase verbosity (can be passed multiple times)"+  ]

@@ -0,0 +1,12 @@+module Stackctl.Version+  ( logVersion+  ) where++import Stackctl.Prelude++import Data.Version+import qualified Paths_stackctl as Pkg+import Prelude (putStrLn)++logVersion :: MonadIO m => m ()+logVersion = liftIO $ putStrLn $ ("Stackctl v" <>) $ showVersion Pkg.version

@@ -0,0 +1,33 @@+-- | A copy of "Control.Exception.Lens" on 'MonadUnliftIO'+--+-- And only the parts we use in this code-base+--+module UnliftIO.Exception.Lens+  ( handling_+  , trying+  ) where++import Prelude++import Control.Lens (Getting, preview)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Monoid (First)+import UnliftIO.Exception (SomeException, catchJust, tryJust)++catching_+  :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m r -> m r+catching_ l a b = catchJust (preview l) a (const b)+{-# INLINE catching_ #-}++handling_+  :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m r -> m r+handling_ l = flip (catching_ l)+{-# INLINE handling_ #-}++trying+  :: MonadUnliftIO m+  => Getting (First a) SomeException a+  -> m r+  -> m (Either a r)+trying l = tryJust (preview l)+{-# INLINE trying #-}

@@ -0,0 +1,209 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name:           stackctl+version:        1.1.0.0+description:    Please see <https://github.com/freckle/stackctl#readme>+homepage:       https://github.com/freckle/stackctl#readme+bug-reports:    https://github.com/freckle/stackctl/issues+author:         Freckle Engineering+maintainer:     freckle-engineering@renaissance.com+copyright:      2022 Renaissance Learning Inc+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/freckle/stackctl++library+  exposed-modules:+      Stackctl.Action+      Stackctl.AWS+      Stackctl.AWS.CloudFormation+      Stackctl.AWS.Core+      Stackctl.AWS.EC2+      Stackctl.AWS.Lambda+      Stackctl.AWS.Orphans+      Stackctl.AWS.Scope+      Stackctl.AWS.STS+      Stackctl.CLI+      Stackctl.ColorOption+      Stackctl.Colors+      Stackctl.Commands+      Stackctl.DirectoryOption+      Stackctl.FilterOption+      Stackctl.Options+      Stackctl.Prelude+      Stackctl.Prompt+      Stackctl.Spec.Capture+      Stackctl.Spec.Cat+      Stackctl.Spec.Changes+      Stackctl.Spec.Changes.Format+      Stackctl.Spec.Deploy+      Stackctl.Spec.Discover+      Stackctl.Spec.Generate+      Stackctl.StackSpec+      Stackctl.StackSpecPath+      Stackctl.StackSpecYaml+      Stackctl.Subcommand+      Stackctl.VerboseOption+      Stackctl.Version+      UnliftIO.Exception.Lens+  other-modules:+      Paths_stackctl+  hs-source-dirs:+      src+  default-extensions:+      BangPatterns+      DataKinds+      DeriveAnyClass+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      NoImplicitPrelude+      NoMonomorphismRestriction+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      StandaloneDeriving+      TypeApplications+      TypeFamilies+  ghc-options: -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unsafe -optP-Wno-nonportable-include-path+  build-depends:+      Blammo >=1.1.0.0+    , Glob+    , aeson+    , aeson-casing+    , aeson-pretty+    , amazonka+    , amazonka-cloudformation+    , amazonka-core+    , amazonka-ec2+    , amazonka-lambda+    , amazonka-sts+    , base ==4.*+    , bytestring+    , cfn-flip+    , conduit+    , containers+    , errors+    , exceptions+    , extra+    , fast-logger+    , filepath+    , lens+    , lens-aeson+    , monad-logger+    , optparse-applicative+    , resourcet+    , rio+    , text+    , time+    , unliftio+    , unliftio-core+    , unordered-containers+    , uuid+    , yaml+  default-language: Haskell2010++executable stackctl+  main-is: Main.hs+  other-modules:+      Paths_stackctl+  hs-source-dirs:+      app+  default-extensions:+      BangPatterns+      DataKinds+      DeriveAnyClass+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      NoImplicitPrelude+      NoMonomorphismRestriction+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      StandaloneDeriving+      TypeApplications+      TypeFamilies+  ghc-options: -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unsafe -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base ==4.*+    , stackctl+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Stackctl.AWS.CloudFormationSpec+      Stackctl.FilterOptionSpec+      Stackctl.StackSpecSpec+      Stackctl.StackSpecYamlSpec+      Paths_stackctl+  hs-source-dirs:+      test+  default-extensions:+      BangPatterns+      DataKinds+      DeriveAnyClass+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      NoImplicitPrelude+      NoMonomorphismRestriction+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      StandaloneDeriving+      TypeApplications+      TypeFamilies+  ghc-options: -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unsafe -optP-Wno-nonportable-include-path+  build-depends:+      base ==4.*+    , hspec+    , stackctl+    , yaml+  default-language: Haskell2010

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,28 @@+module Stackctl.AWS.CloudFormationSpec+  ( spec+  ) where++import Stackctl.Prelude++import Data.List (isSuffixOf)+import Stackctl.AWS.CloudFormation+import Test.Hspec++spec :: Spec+spec = do+  describe "readParameter" $ do+    it "refuses empty key" $ do+      readParameter "=Value"+        `shouldSatisfy` either ("empty KEY" `isSuffixOf`) (const False)++    it "refuses empty value" $ do+      readParameter "Key"+        `shouldSatisfy` either ("empty VALUE" `isSuffixOf`) (const False)++    it "refuses empty value (with =)" $ do+      readParameter "Key="+        `shouldSatisfy` either ("empty VALUE" `isSuffixOf`) (const False)++    it "creates a parameter when valid" $ do+      readParameter "Key=Value=More"+        `shouldBe` Right (makeParameter "Key" $ Just "Value=More")

@@ -0,0 +1,35 @@+module Stackctl.FilterOptionSpec+  ( spec+  ) where++import Stackctl.Prelude++import Stackctl.FilterOption+import Test.Hspec++spec :: Spec+spec = do+  describe "filterFilePaths" $ do+    it "filters paths matching any of the given patterns" $ do+      let+        option =+          filterOptionFromPaths $ "some-path" :| ["prefix/*", "**/suffix"]+        paths =+          [ "some-path"+          , "some-path-other"+          , "other-some-path"+          , "prefix/foo"+          , "prefix/foo-bar"+          , "prefix/foo-bar/prefix"+          , "foo/suffix"+          , "foo/bar/suffix"+          , "foo/suffix/bar"+          ]++      filterFilePaths option paths+        `shouldMatchList` [ "some-path"+                          , "prefix/foo"+                          , "prefix/foo-bar"+                          , "foo/suffix"+                          , "foo/bar/suffix"+                          ]

@@ -0,0 +1,50 @@+module Stackctl.StackSpecSpec+  ( spec+  ) where++import Stackctl.Prelude++import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.StackSpec+import Stackctl.StackSpecPath+import Stackctl.StackSpecYaml+import Test.Hspec++spec :: Spec+spec = do+  describe "sortStackSpecs" $ do+    it "orders dependencies before dependents" $ do+      let+        specs =+          [ toSpec "app" ["roles", "iam", "networking"]+          , toSpec "roles" ["iam"]+          , toSpec "iam" []+          , toSpec "networking" []+          ]++      map specName (sortStackSpecs specs)+        `shouldBe` ["iam", "roles", "networking", "app"]++toSpec :: Text -> [Text] -> StackSpec+toSpec name depends = buildStackSpec "." specPath specBody+ where+  stackName = StackName name+  specPath = stackSpecPath scope stackName "a/b.yaml"+  specBody = StackSpecYaml+    { ssyDepends = Just $ map StackName depends+    , ssyActions = Nothing+    , ssyTemplate = ""+    , ssyParameters = Nothing+    , ssyCapabilities = Nothing+    , ssyTags = Nothing+    }++  scope = AwsScope+    { awsAccountId = AccountId ""+    , awsAccountName = ""+    , awsRegion = Region' ""+    }++specName :: StackSpec -> Text+specName = unStackName . stackSpecStackName

@@ -0,0 +1,75 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++module Stackctl.StackSpecYamlSpec+  ( spec+  ) where++import Stackctl.Prelude++import qualified Data.Yaml as Yaml+import Stackctl.AWS+import Stackctl.StackSpecYaml+import Test.Hspec++spec :: Spec+spec = do+  describe "decoding Yaml" $ do+    it "reads String parameters" $ do+      StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat+        [ "Template: foo.yaml\n"+        , "Parameters:\n"+        , "  - ParameterKey: Foo\n"+        , "    ParameterValue: Bar\n"+        ]++      let Just [ParameterYaml param] = ssyParameters+      param ^. parameter_parameterKey `shouldBe` Just "Foo"+      param ^. parameter_parameterValue `shouldBe` Just "Bar"++    it "reads Number parameters without decimals" $ do+      StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat+        [ "Template: foo.yaml\n"+        , "Parameters:\n"+        , "  - ParameterKey: Port\n"+        , "    ParameterValue: 80\n"+        ]++      let Just [ParameterYaml param] = ssyParameters+      param ^. parameter_parameterKey `shouldBe` Just "Port"+      param ^. parameter_parameterValue `shouldBe` Just "80"++    it "reads Number parameters with decimals" $ do+      StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat+        [ "Template: foo.yaml\n"+        , "Parameters:\n"+        , "  - ParameterKey: Pie\n"+        , "    ParameterValue: 3.14\n"+        ]++      let Just [ParameterYaml param] = ssyParameters+      param ^. parameter_parameterKey `shouldBe` Just "Pie"+      param ^. parameter_parameterValue `shouldBe` Just "3.14"++    it "has informative errors" $ do+      let+        Left ex = Yaml.decodeEither' @StackSpecYaml $ mconcat+          [ "Template: foo.yaml\n"+          , "Parameters:\n"+          , "  - ParameterKey: Norway\n"+          , "    ParameterValue: no\n"+          ]++      show ex+        `shouldBe` "AesonException \"Error in $.Parameters[0].ParameterValue: Expected String or Number, got: Bool False\""++    it "also accepts CloudGenesis formatted values" $ do+      StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat+        [ "Template: foo.yaml\n"+        , "Parameters:\n"+        , "  - Name: Foo\n"+        , "    Value: Bar\n"+        ]++      let Just [ParameterYaml param] = ssyParameters+      param ^. parameter_parameterKey `shouldBe` Just "Foo"+      param ^. parameter_parameterValue `shouldBe` Just "Bar"