From 4a97f1549e3100df23552a5d67cac8683193646f Mon Sep 17 00:00:00 2001 From: Cristina Grant Date: Mon, 26 Jun 2023 19:29:39 -0400 Subject: [PATCH 1/8] Update README.md (#49) --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index e095ff6..8b61894 100644 --- a/README.md +++ b/README.md @@ -24,6 +24,7 @@ This project also contains a Haskell library for doing the same. - Have `~/.local/bin` on your `$PATH` - Have `~/.local/share/man` on your `$MANPATH` (for documentation) - If on OSX, `brew install coreutils` (i.e. have `ginstall` available) +- If on OSX, `brew install jq` ### Scripted From 55744d47b56e2c440feeb5d36aaaea72eeca7d9d Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Wed, 14 Jun 2023 09:17:07 -0400 Subject: [PATCH 2/8] Use upstreamed UnliftIO.Exception.Lens --- package.yaml | 3 +-- src/UnliftIO/Exception/Lens.hs | 33 --------------------------------- stack.yaml | 1 + stack.yaml.lock | 7 +++++++ stackctl.cabal | 6 ++---- 5 files changed, 11 insertions(+), 39 deletions(-) delete mode 100644 src/UnliftIO/Exception/Lens.hs diff --git a/package.yaml b/package.yaml index 5153b16..b6c07e0 100644 --- a/package.yaml +++ b/package.yaml @@ -92,8 +92,7 @@ library: - time - transformers - typed-process - - unliftio - - unliftio-core + - unliftio >= 0.2.25.0 # UnliftIO.Exception.Lens - unordered-containers - uuid - yaml diff --git a/src/UnliftIO/Exception/Lens.hs b/src/UnliftIO/Exception/Lens.hs deleted file mode 100644 index da10b83..0000000 --- a/src/UnliftIO/Exception/Lens.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | 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 #-} diff --git a/stack.yaml b/stack.yaml index ccd5b42..f5cf943 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,6 +3,7 @@ resolver: lts-20.4 extra-deps: - Blammo-1.1.1.1 - cfn-flip-0.1.0.3 + - unliftio-0.2.25.0 - github: brendanhay/amazonka commit: f73a957d05f64863e867cf39d0db260718f0fadd # main, as of SSO support diff --git a/stack.yaml.lock b/stack.yaml.lock index 5085e31..5b3ab93 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,6 +18,13 @@ packages: size: 3139 original: hackage: cfn-flip-0.1.0.3 +- completed: + hackage: unliftio-0.2.25.0@sha256:d015242554890370bcbc3a575019be691d0edc279736ef97d29412fb9d0c4349,3410 + pantry-tree: + sha256: 08c62f256e740e1a78b175907c26cb06439a1b486ceb8021c5a2e4425ebb6c5b + size: 2494 + original: + hackage: unliftio-0.2.25.0 - completed: name: amazonka pantry-tree: diff --git a/stackctl.cabal b/stackctl.cabal index 7be1176..7e4b7b8 100644 --- a/stackctl.cabal +++ b/stackctl.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -65,7 +65,6 @@ library Stackctl.TagOption Stackctl.VerboseOption Stackctl.Version - UnliftIO.Exception.Lens other-modules: Paths_stackctl hs-source-dirs: @@ -133,8 +132,7 @@ library , time , transformers , typed-process - , unliftio - , unliftio-core + , unliftio >=0.2.25.0 , unordered-containers , uuid , yaml From 294997d3757f751eda78c28d2313a01cf4d0e6bd Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Fri, 30 Jun 2023 09:00:45 -0400 Subject: [PATCH 3/8] Convert project to Fourmolu --- .restyled.yaml | 4 +- .stylish-haskell.yaml | 25 --- brittany.yaml | 71 -------- fourmolu.yaml | 15 ++ src/Stackctl/AWS/CloudFormation.hs | 169 +++++++++--------- src/Stackctl/AWS/Core.hs | 50 +++--- src/Stackctl/AWS/EC2.hs | 2 +- src/Stackctl/AWS/Lambda.hs | 71 ++++---- src/Stackctl/AWS/Orphans.hs | 70 +++++--- src/Stackctl/AWS/Scope.hs | 46 ++--- src/Stackctl/Action.hs | 27 +-- src/Stackctl/AutoSSO.hs | 18 +- src/Stackctl/CLI.hs | 30 ++-- src/Stackctl/ColorOption.hs | 14 +- src/Stackctl/Colors.hs | 4 +- src/Stackctl/Commands.hs | 78 +++++---- src/Stackctl/Config.hs | 48 +++--- src/Stackctl/Config/RequiredVersion.hs | 18 +- src/Stackctl/DirectoryOption.hs | 31 ++-- src/Stackctl/FilterOption.hs | 34 ++-- src/Stackctl/Options.hs | 41 +++-- src/Stackctl/ParameterOption.hs | 17 +- src/Stackctl/Prelude.hs | 11 +- src/Stackctl/RemovedStack.hs | 2 +- src/Stackctl/Spec/Capture.hs | 110 +++++++----- src/Stackctl/Spec/Cat.hs | 92 +++++----- src/Stackctl/Spec/Changes.hs | 35 ++-- src/Stackctl/Spec/Changes/Format.hs | 88 +++++----- src/Stackctl/Spec/Deploy.hs | 98 ++++++----- src/Stackctl/Spec/Discover.hs | 8 +- src/Stackctl/Spec/Generate.hs | 53 +++--- src/Stackctl/Spec/List.hs | 4 +- src/Stackctl/StackDescription.hs | 16 +- src/Stackctl/StackSpec.hs | 36 ++-- src/Stackctl/StackSpecPath.hs | 45 ++--- src/Stackctl/StackSpecYaml.hs | 23 ++- src/Stackctl/Subcommand.hs | 13 +- src/Stackctl/TagOption.hs | 17 +- src/Stackctl/VerboseOption.hs | 16 +- test/Spec.hs | 2 +- test/Stackctl/AWS/ScopeSpec.hs | 12 +- test/Stackctl/Config/RequiredVersionSpec.hs | 4 +- test/Stackctl/ConfigSpec.hs | 42 ++--- test/Stackctl/FilterOptionSpec.hs | 42 +++-- test/Stackctl/StackDescriptionSpec.hs | 8 +- test/Stackctl/StackSpecSpec.hs | 48 +++--- test/Stackctl/StackSpecYamlSpec.hs | 182 +++++++++++--------- 47 files changed, 987 insertions(+), 903 deletions(-) delete mode 100644 .stylish-haskell.yaml delete mode 100644 brittany.yaml create mode 100644 fourmolu.yaml diff --git a/.restyled.yaml b/.restyled.yaml index dbf806a..f3c387a 100644 --- a/.restyled.yaml +++ b/.restyled.yaml @@ -1,6 +1,8 @@ restylers_version: dev restylers: - - brittany + - fourmolu + - stylish-haskell: + enabled: false - prettier-markdown: enabled: false - whitespace: diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml deleted file mode 100644 index b146c9e..0000000 --- a/.stylish-haskell.yaml +++ /dev/null @@ -1,25 +0,0 @@ ---- -steps: - - simple_align: - cases: false - top_level_patterns: false - records: false - - imports: - align: none - list_align: after_alias - pad_module_names: false - long_list_align: new_line_multiline - empty_list_align: right_after - list_padding: 2 - separate_lists: false - space_surround: false - - language_pragmas: - style: vertical - align: false - remove_redundant: false - - trailing_whitespace: {} -columns: 80 -newline: native - -# Infer extensions from .cabal file -cabal: true diff --git a/brittany.yaml b/brittany.yaml deleted file mode 100644 index 368522f..0000000 --- a/brittany.yaml +++ /dev/null @@ -1,71 +0,0 @@ ---- -conf_debug: - dconf_roundtrip_exactprint_only: false - dconf_dump_bridoc_simpl_par: false - dconf_dump_ast_unknown: false - dconf_dump_bridoc_simpl_floating: false - dconf_dump_config: false - dconf_dump_bridoc_raw: false - dconf_dump_bridoc_final: false - dconf_dump_bridoc_simpl_alt: false - dconf_dump_bridoc_simpl_indent: false - dconf_dump_annotations: false - dconf_dump_bridoc_simpl_columns: false - dconf_dump_ast_full: false -conf_forward: - options_ghc: - - -XBangPatterns - - -XDataKinds - - -XDeriveAnyClass - - -XDeriveFoldable - - -XDeriveFunctor - - -XDeriveGeneric - - -XDeriveLift - - -XDeriveTraversable - - -XDerivingStrategies - - -XDerivingVia - - -XFlexibleContexts - - -XFlexibleInstances - - -XGADTs - - -XGeneralizedNewtypeDeriving - - -XLambdaCase - - -XMultiParamTypeClasses - - -XNoImplicitPrelude - - -XNoMonomorphismRestriction - - -XOverloadedStrings - - -XRankNTypes - - -XRecordWildCards - - -XScopedTypeVariables - - -XStandaloneDeriving - - -XTypeApplications - - -XTypeFamilies -conf_errorHandling: - econf_ExactPrintFallback: ExactPrintFallbackModeInline - econf_Werror: false - econf_omit_output_valid_check: false - econf_produceOutputOnErrors: false -conf_preprocessor: - ppconf_CPPMode: CPPModeAbort - ppconf_hackAroundIncludes: false -conf_obfuscate: false -conf_roundtrip_exactprint_only: false -conf_version: 1 -conf_layout: - lconfig_reformatModulePreamble: true - lconfig_altChooser: - tag: AltChooserBoundedSearch - contents: 3 - lconfig_allowSingleLineExportList: false - lconfig_importColumn: 60 - lconfig_hangingTypeSignature: false - lconfig_importAsColumn: 50 - lconfig_alignmentLimit: 1 - lconfig_indentListSpecial: true - lconfig_indentAmount: 2 - lconfig_alignmentBreakOnMultiline: true - lconfig_cols: 80 - lconfig_indentPolicy: IndentPolicyLeft - lconfig_indentWhereSpecial: true - lconfig_columnAlignMode: - tag: ColumnAlignModeDisabled - contents: 0.7 diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..ef571e8 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,15 @@ +indentation: 2 +column-limit: 80 # ignored until v12 / ghc-9.6 +function-arrows: leading +comma-style: leading # default +import-export-style: leading +indent-wheres: false # default +record-brace-space: true +newlines-between-decls: 1 # default +haddock-style: single-line +let-style: mixed +in-style: left-align +single-constraint-parens: never # ignored until v12 / ghc-9.6 +unicode: never # default +respectful: true # default +fixities: [] # default diff --git a/src/Stackctl/AWS/CloudFormation.hs b/src/Stackctl/AWS/CloudFormation.hs index 71d7094..8a24f5e 100644 --- a/src/Stackctl/AWS/CloudFormation.hs +++ b/src/Stackctl/AWS/CloudFormation.hs @@ -1,23 +1,23 @@ module Stackctl.AWS.CloudFormation - ( Stack(..) + ( Stack (..) , stack_stackName , stackDescription , stackStatusRequiresDeletion - , StackId(..) - , StackName(..) - , StackDescription(..) - , StackStatus(..) - , StackEvent(..) - , ResourceStatus(..) + , StackId (..) + , StackName (..) + , StackDescription (..) + , StackStatus (..) + , StackEvent (..) + , ResourceStatus (..) , stackEvent_eventId , stackEvent_logicalResourceId , stackEvent_resourceStatus , stackEvent_resourceStatusReason , stackEvent_timestamp - , StackTemplate(..) - , StackDeployResult(..) + , StackTemplate (..) + , StackDeployResult (..) , prettyStackDeployResult - , StackDeleteResult(..) + , StackDeleteResult (..) , prettyStackDeleteResult , Parameter , parameter_parameterKey @@ -25,7 +25,7 @@ module Stackctl.AWS.CloudFormation , newParameter , makeParameter , readParameter - , Capability(..) + , Capability (..) , Tag , newTag , tag_key @@ -43,20 +43,20 @@ module Stackctl.AWS.CloudFormation , awsCloudFormationWait , awsCloudFormationGetTemplate - -- * ChangeSets - , ChangeSet(..) + -- * ChangeSets + , ChangeSet (..) , changeSetJSON - , ChangeSetId(..) - , ChangeSetName(..) - , Change(..) - , ResourceChange(..) - , Replacement(..) - , ChangeAction(..) - , ResourceAttribute(..) - , ResourceChangeDetail(..) - , ChangeSource(..) - , ResourceTargetDefinition(..) - , RequiresRecreation(..) + , ChangeSetId (..) + , ChangeSetName (..) + , Change (..) + , ResourceChange (..) + , Replacement (..) + , ChangeAction (..) + , ResourceAttribute (..) + , ResourceChangeDetail (..) + , ChangeSource (..) + , ResourceTargetDefinition (..) + , RequiresRecreation (..) , awsCloudFormationCreateChangeSet , awsCloudFormationExecuteChangeSet , awsCloudFormationDeleteAllChangeSets @@ -80,13 +80,13 @@ import Amazonka.CloudFormation.Waiters import Amazonka.Core ( AsError , ServiceError - , _MatchServiceError - , _ServiceError , hasStatus , serviceCode , serviceMessage + , _MatchServiceError + , _ServiceError ) -import Amazonka.Waiter (Accept(..)) +import Amazonka.Waiter (Accept (..)) import Conduit import Control.Lens ((?~)) import Data.Aeson @@ -127,14 +127,14 @@ data StackDeployResult | StackCreateFailure Bool | StackUpdateSuccess | StackUpdateFailure Bool - deriving stock Show + deriving stock (Show) prettyStackDeployResult :: StackDeployResult -> Text prettyStackDeployResult = \case StackCreateSuccess -> "Created Stack successfully" - StackCreateFailure{} -> "Failed to create Stack" + StackCreateFailure {} -> "Failed to create Stack" StackUpdateSuccess -> "Updated Stack successfully" - StackUpdateFailure{} -> "Failed to update Stack" + StackUpdateFailure {} -> "Failed to update Stack" stackCreateResult :: Accept -> StackDeployResult stackCreateResult = \case @@ -155,7 +155,7 @@ data StackDeleteResult prettyStackDeleteResult :: StackDeleteResult -> Text prettyStackDeleteResult = \case StackDeleteSuccess -> "Deleted Stack successfully" - StackDeleteFailure{} -> "Failed to delete Stack" + StackDeleteFailure {} -> "Failed to delete Stack" stackDeleteResult :: Accept -> StackDeleteResult stackDeleteResult = \case @@ -174,8 +174,7 @@ newChangeSetName = liftIO $ do awsCloudFormationDescribeStack :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName -> m Stack awsCloudFormationDescribeStack stackName = do - let - req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName + let req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName awsSimple "DescribeStack" req $ \resp -> do stacks <- resp ^. describeStacksResponse_stacks @@ -202,14 +201,14 @@ awsCloudFormationDescribeStackOutputs stackName = do awsCloudFormationDescribeStackEvents :: (MonadResource m, MonadReader env m, HasAwsEnv env) => StackName - -> Maybe Text -- ^ Last-seen Id + -> Maybe Text + -- ^ Last-seen Id -> m [StackEvent] awsCloudFormationDescribeStackEvents stackName mLastId = do - let - req = - newDescribeStackEvents - & describeStackEvents_stackName - ?~ unStackName stackName + let req = + newDescribeStackEvents + & describeStackEvents_stackName + ?~ unStackName stackName runConduit $ awsPaginate req @@ -277,9 +276,10 @@ awsCloudFormationWait => StackName -> m StackDeployResult awsCloudFormationWait stackName = do - either stackCreateResult stackUpdateResult <$> race - (awsAwait newStackCreateComplete req) - (awsAwait newStackUpdateComplete req) + either stackCreateResult stackUpdateResult + <$> race + (awsAwait newStackCreateComplete req) + (awsAwait newStackUpdateComplete req) where req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName @@ -359,27 +359,27 @@ awsCloudFormationCreateChangeSet -> [Capability] -> [Tag] -> m (Either Text (Maybe ChangeSet)) -awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate parameters capabilities tags - = fmap (first formatServiceError) +awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate parameters capabilities tags = + fmap (first formatServiceError) $ trying (_ServiceError . hasStatus 400) $ do - name <- newChangeSetName + name <- newChangeSetName - logDebug $ "Reading Template" :# ["path" .= stackTemplate] - templateBody <- addStackDescription mStackDescription + logDebug $ "Reading Template" :# ["path" .= stackTemplate] + templateBody <- + addStackDescription mStackDescription <$> readFileUtf8 (unStackTemplate stackTemplate) - mStack <- awsCloudFormationDescribeStackMaybe stackName + mStack <- awsCloudFormationDescribeStackMaybe stackName - let - changeSetType = fromMaybe ChangeSetType_CREATE $ do + let changeSetType = fromMaybe ChangeSetType_CREATE $ do stack <- mStack - pure $ if stackIsAbandonedCreate stack - then ChangeSetType_CREATE - else ChangeSetType_UPDATE + pure + $ if stackIsAbandonedCreate stack + then ChangeSetType_CREATE + else ChangeSetType_UPDATE - let - req = + let req = newCreateChangeSet (unStackName stackName) (unChangeSetName name) & (createChangeSet_changeSetType ?~ changeSetType) . (createChangeSet_templateBody ?~ templateBody) @@ -387,17 +387,17 @@ awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate param . (createChangeSet_capabilities ?~ capabilities) . (createChangeSet_tags ?~ tags) - logInfo - $ "Creating changeset..." - :# ["name" .= name, "type" .= changeSetType] - csId <- awsSimple "CreateChangeSet" req (^. createChangeSetResponse_id) + logInfo + $ "Creating changeset..." + :# ["name" .= name, "type" .= changeSetType] + csId <- awsSimple "CreateChangeSet" req (^. createChangeSetResponse_id) - logDebug "Awaiting CREATE_COMPLETE" - void $ awsAwait newChangeSetCreateComplete $ newDescribeChangeSet csId + logDebug "Awaiting CREATE_COMPLETE" + void $ awsAwait newChangeSetCreateComplete $ newDescribeChangeSet csId - logInfo "Retrieving changeset..." - cs <- awsCloudFormationDescribeChangeSet $ ChangeSetId csId - pure $ cs <$ guard (not $ changeSetFailed cs) + logInfo "Retrieving changeset..." + cs <- awsCloudFormationDescribeChangeSet $ ChangeSetId csId + pure $ cs <$ guard (not $ changeSetFailed cs) awsCloudFormationDescribeChangeSet :: (MonadResource m, MonadReader env m, HasAwsEnv env) @@ -452,15 +452,15 @@ awsCloudFormationDeleteAllChangeSets stackName = do runConduit $ awsPaginate (newListChangeSets $ unStackName stackName) .| concatMapC - (\resp -> fromMaybe [] $ do - ss <- resp ^. listChangeSetsResponse_summaries - pure $ mapMaybe Summary.changeSetId ss - ) + ( \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 - ) + ( \csId -> do + logInfo $ "Enqueing delete" :# ["changeSetId" .= csId] + void $ awsSend $ newDeleteChangeSet csId + ) -- | Did we abandoned this Stack's first ever ChangeSet? -- @@ -474,16 +474,20 @@ awsCloudFormationDeleteAllChangeSets stackName = do -- 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) + stack + ^. stack_stackStatus + == StackStatus_REVIEW_IN_PROGRESS + && isNothing + (stack ^. stack_lastUpdatedTime) stackStatusRequiresDeletion :: Stack -> Maybe StackStatus -stackStatusRequiresDeletion stack = status - <$ guard (status `elem` requiresDeletionStatuses) - where status = stack ^. stack_stackStatus +stackStatusRequiresDeletion stack = + status + <$ guard (status `elem` requiresDeletionStatuses) + where + status = stack ^. stack_stackStatus requiresDeletionStatuses :: [StackStatus] requiresDeletionStatuses = @@ -501,7 +505,8 @@ _ValidationError = _MatchServiceError defaultService "ValidationError" . hasStatus 400 formatServiceError :: ServiceError -> Text -formatServiceError e = mconcat - [ toText $ e ^. serviceCode - , maybe "" ((": " <>) . toText) $ e ^. serviceMessage - ] +formatServiceError e = + mconcat + [ toText $ e ^. serviceCode + , maybe "" ((": " <>) . toText) $ e ^. serviceMessage + ] diff --git a/src/Stackctl/AWS/Core.hs b/src/Stackctl/AWS/Core.hs index de5bff5..21f2f2b 100644 --- a/src/Stackctl/AWS/Core.hs +++ b/src/Stackctl/AWS/Core.hs @@ -1,6 +1,6 @@ module Stackctl.AWS.Core ( AwsEnv - , HasAwsEnv(..) + , HasAwsEnv (..) , awsEnvDiscover , awsSimple , awsSend @@ -8,23 +8,23 @@ module Stackctl.AWS.Core , awsAwait , awsAssumeRole - -- * Modifiers on 'AwsEnv' + -- * Modifiers on 'AwsEnv' , awsWithin , awsTimeout - -- * 'Amazonka' extensions - , AccountId(..) + -- * 'Amazonka' extensions + , AccountId (..) - -- * 'Amazonka'/'ResourceT' re-exports - , Region(..) - , FromText(..) - , ToText(..) + -- * 'Amazonka'/'ResourceT' re-exports + , Region (..) + , FromText (..) + , ToText (..) , MonadResource ) where import Stackctl.Prelude hiding (timeout) -import Amazonka hiding (LogLevel(..)) +import Amazonka hiding (LogLevel (..)) import qualified Amazonka as AWS import Amazonka.Auth.Keys (fromSession) import Amazonka.STS.AssumeRole @@ -38,7 +38,7 @@ newtype AwsEnv = AwsEnv } unL :: Lens' AwsEnv Env -unL = lens unAwsEnv $ \x y -> x { unAwsEnv = y } +unL = lens unAwsEnv $ \x y -> x {unAwsEnv = y} awsEnvDiscover :: MonadLoggerIO m => m AwsEnv awsEnvDiscover = do @@ -48,19 +48,20 @@ awsEnvDiscover = do 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) - } + 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 @@ -77,7 +78,8 @@ awsSimple awsSimple name req post = do resp <- awsSend req maybe (throwString err) pure $ post resp - where err = unpack name <> " successful, but processing the response failed" + where + err = unpack name <> " successful, but processing the response failed" awsSend :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a) diff --git a/src/Stackctl/AWS/EC2.hs b/src/Stackctl/AWS/EC2.hs index b89d8ba..92528f5 100644 --- a/src/Stackctl/AWS/EC2.hs +++ b/src/Stackctl/AWS/EC2.hs @@ -5,7 +5,7 @@ module Stackctl.AWS.EC2 import Stackctl.Prelude import Amazonka.EC2.DescribeAvailabilityZones -import Amazonka.EC2.Types (AvailabilityZone(..)) +import Amazonka.EC2.Types (AvailabilityZone (..)) import Stackctl.AWS.Core awsEc2DescribeFirstAvailabilityZoneRegionName diff --git a/src/Stackctl/AWS/Lambda.hs b/src/Stackctl/AWS/Lambda.hs index a5566b8..f111736 100644 --- a/src/Stackctl/AWS/Lambda.hs +++ b/src/Stackctl/AWS/Lambda.hs @@ -1,8 +1,8 @@ {-# LANGUAGE MultiWayIf #-} module Stackctl.AWS.Lambda - ( LambdaInvokeResult(..) - , LambdaError(..) + ( LambdaInvokeResult (..) + , LambdaError (..) , logLambdaInvocationResult , isLambdaInvocationSuccess , awsLambdaInvoke @@ -19,36 +19,40 @@ data LambdaInvokeResult = LambdaInvokeSuccess ByteString | LambdaInvokeError LambdaError (Maybe Text) | LambdaInvokeFailure Int (Maybe Text) - deriving stock Show + deriving stock (Show) logLambdaInvocationResult :: MonadLogger m => LambdaInvokeResult -> m () logLambdaInvocationResult = \case LambdaInvokeSuccess bs -> do - let - meta = case decode @Value $ BSL.fromStrict bs of - Nothing -> ["response" .= decodeUtf8 bs] - Just response -> ["response" .= response] + let meta = case decode @Value $ BSL.fromStrict bs of + Nothing -> ["response" .= decodeUtf8 bs] + Just response -> ["response" .= response] logInfo $ "LambdaInvokeSuccess" :# meta 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 - ] + 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 + LambdaInvokeSuccess {} -> True + LambdaInvokeError {} -> False + LambdaInvokeFailure {} -> False data LambdaError = LambdaError { errorType :: Text @@ -66,14 +70,20 @@ awsLambdaInvoke , ToJSON a ) => Text - -> a -- ^ Payload + -> a + -- ^ Payload -> m LambdaInvokeResult awsLambdaInvoke name payload = do logDebug $ "Invoking function" :# ["name" .= name] -- Match Lambda's own limit (15 minutes) and add some buffer - resp <- awsTimeout 905 $ awsSend $ newInvoke name $ BSL.toStrict $ encode - payload + resp <- + awsTimeout 905 + $ awsSend + $ newInvoke name + $ BSL.toStrict + $ encode + payload let status = resp ^. invokeResponse_statusCode @@ -89,10 +99,11 @@ awsLambdaInvoke name payload = do , "functionError" .= mFunctionError ] - pure $ if - | statusIsUnsuccessful status -> LambdaInvokeFailure status mFunctionError - | Just e <- mError -> LambdaInvokeError e mFunctionError - | otherwise -> LambdaInvokeSuccess response + pure + $ if + | statusIsUnsuccessful status -> LambdaInvokeFailure status mFunctionError + | Just e <- mError -> LambdaInvokeError e mFunctionError + | otherwise -> LambdaInvokeSuccess response statusIsUnsuccessful :: Int -> Bool statusIsUnsuccessful s = s < 200 || s >= 300 diff --git a/src/Stackctl/AWS/Orphans.hs b/src/Stackctl/AWS/Orphans.hs index e67ec8a..a1867f7 100644 --- a/src/Stackctl/AWS/Orphans.hs +++ b/src/Stackctl/AWS/Orphans.hs @@ -5,9 +5,7 @@ -- -- Orphans so we can get @'ToJSON' 'ChangeSet'@ without hand-writing a massive, -- incomplete, and doomed-to-drift instance ourselves. --- -module Stackctl.AWS.Orphans - () where +module Stackctl.AWS.Orphans () where import Stackctl.Prelude @@ -17,32 +15,54 @@ import Data.Aeson import GHC.Generics (Rep) -- Makes it syntactally easier to do a bunch of these -newtype Generically a = Generically { unGenerically :: a } +newtype Generically a = Generically {unGenerically :: a} instance ( Generic a , GToJSON' Value Zero (Rep a) , GToJSON' Encoding Zero (Rep a) - ) => ToJSON (Generically a) where + ) + => 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 +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 diff --git a/src/Stackctl/AWS/Scope.hs b/src/Stackctl/AWS/Scope.hs index 2ffac7e..6846ba9 100644 --- a/src/Stackctl/AWS/Scope.hs +++ b/src/Stackctl/AWS/Scope.hs @@ -1,8 +1,8 @@ module Stackctl.AWS.Scope - ( AwsScope(..) + ( AwsScope (..) , awsScopeSpecPatterns , awsScopeSpecStackName - , HasAwsScope(..) + , HasAwsScope (..) , fetchAwsScope ) where @@ -20,26 +20,26 @@ data AwsScope = AwsScope , awsRegion :: Region } deriving stock (Eq, Show, Generic) - deriving anyclass ToJSON + deriving anyclass (ToJSON) awsScopeSpecPatterns :: AwsScope -> [Pattern] awsScopeSpecPatterns AwsScope {..} = [ compile - $ "stacks" - unpack (unAccountId awsAccountId) - <> ".*" - unpack (fromRegion awsRegion) - <> "**" - "*" - <.> "yaml" + $ "stacks" + unpack (unAccountId awsAccountId) + <> ".*" + unpack (fromRegion awsRegion) + <> "**" + "*" + <.> "yaml" , compile - $ "stacks" - "*." - <> unpack (unAccountId awsAccountId) - unpack (fromRegion awsRegion) - <> "**" - "*" - <.> "yaml" + $ "stacks" + "*." + <> unpack (unAccountId awsAccountId) + unpack (fromRegion awsRegion) + <> "**" + "*" + <.> "yaml" ] awsScopeSpecStackName :: AwsScope -> FilePath -> Maybe StackName @@ -49,13 +49,13 @@ awsScopeSpecStackName scope path = do -- once we've guarded that the path matches our scope patterns, we can play it -- pretty fast and loose with the "parsing" step pure - $ path -- stacks/account/region/x/y.yaml - & splitPath -- [stacks/, account/, region/, x/, y.yaml] - & drop 3 -- [x, y.yaml] - & joinPath -- x/y.yaml - & dropExtension -- x/y + $ path -- stacks/account/region/x/y.yaml + & splitPath -- [stacks/, account/, region/, x/, y.yaml] + & drop 3 -- [x, y.yaml] + & joinPath -- x/y.yaml + & dropExtension -- x/y & pack - & T.replace "/" "-" -- x-y + & T.replace "/" "-" -- x-y & StackName class HasAwsScope env where diff --git a/src/Stackctl/Action.hs b/src/Stackctl/Action.hs index 9d94494..294db29 100644 --- a/src/Stackctl/Action.hs +++ b/src/Stackctl/Action.hs @@ -11,12 +11,11 @@ -- run: -- InvokeLambdaByStackOutput: OnDeployFunction -- @ --- module Stackctl.Action ( Action , newAction - , ActionOn(..) - , ActionRun(..) + , ActionOn (..) + , ActionRun (..) , runActions ) where @@ -63,18 +62,20 @@ instance FromJSON ActionRun where <|> (InvokeLambdaByName <$> 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 + 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 | InvokeLambdaFailure - deriving stock Show - deriving anyclass Exception + deriving stock (Show) + deriving anyclass (Exception) runActions :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env) @@ -86,14 +87,14 @@ runActions stackName on = traverse_ (runAction stackName) . filter (`shouldRunOn` on) shouldRunOn :: Action -> ActionOn -> Bool -shouldRunOn Action { on } on' = on == on' +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 +runAction stackName Action {on, run} = do logInfo $ "Running action" :# ["on" .= on, "run" .= run] case run of diff --git a/src/Stackctl/AutoSSO.hs b/src/Stackctl/AutoSSO.hs index 006def9..3a791f8 100644 --- a/src/Stackctl/AutoSSO.hs +++ b/src/Stackctl/AutoSSO.hs @@ -1,7 +1,7 @@ module Stackctl.AutoSSO ( AutoSSOOption , defaultAutoSSOOption - , HasAutoSSOOption(..) + , HasAutoSSOOption (..) , autoSSOOption , envAutoSSOOption , handleAutoSSO @@ -10,8 +10,8 @@ module Stackctl.AutoSSO import Stackctl.Prelude import Amazonka.SSO (_UnauthorizedException) -import Amazonka.Types (Error, ErrorMessage(..), serviceMessage) -import Data.Semigroup (Last(..)) +import Amazonka.Types (Error, ErrorMessage (..), serviceMessage) +import Data.Semigroup (Last (..)) import qualified Env import Options.Applicative import Stackctl.Prompt @@ -21,7 +21,7 @@ data AutoSSOOption = AutoSSOAlways | AutoSSOAsk | AutoSSONever - deriving Semigroup via Last AutoSSOOption + deriving (Semigroup) via Last AutoSSOOption defaultAutoSSOOption :: AutoSSOOption defaultAutoSSOOption = AutoSSOAsk @@ -38,12 +38,14 @@ class HasAutoSSOOption env where autoSSOOptionL :: Lens' env AutoSSOOption autoSSOOption :: Parser AutoSSOOption -autoSSOOption = option (eitherReader readAutoSSO) - $ mconcat [long "auto-sso", help autoSSOHelp, metavar "WHEN"] +autoSSOOption = + option (eitherReader readAutoSSO) + $ mconcat [long "auto-sso", help autoSSOHelp, metavar "WHEN"] envAutoSSOOption :: Env.Parser Env.Error AutoSSOOption -envAutoSSOOption = Env.var (first Env.UnreadError . readAutoSSO) "AUTO_SSO" - $ Env.help autoSSOHelp +envAutoSSOOption = + Env.var (first Env.UnreadError . readAutoSSO) "AUTO_SSO" + $ Env.help autoSSOHelp autoSSOHelp :: IsString a => a autoSSOHelp = "Automatically run aws-sso-login if necessary?" diff --git a/src/Stackctl/CLI.hs b/src/Stackctl/CLI.hs index 5dec511..1bebca1 100644 --- a/src/Stackctl/CLI.hs +++ b/src/Stackctl/CLI.hs @@ -10,9 +10,9 @@ 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.AutoSSO import Stackctl.AWS import Stackctl.AWS.Scope +import Stackctl.AutoSSO import Stackctl.ColorOption import Stackctl.Config import Stackctl.DirectoryOption @@ -28,19 +28,19 @@ data App options = App } optionsL :: Lens' (App options) options -optionsL = lens appOptions $ \x y -> x { appOptions = y } +optionsL = lens appOptions $ \x y -> x {appOptions = y} instance HasLogger (App options) where - loggerL = lens appLogger $ \x y -> x { appLogger = y } + loggerL = lens appLogger $ \x y -> x {appLogger = y} instance HasConfig (App options) where - configL = lens appConfig $ \x y -> x { appConfig = y } + configL = lens appConfig $ \x y -> x {appConfig = y} instance HasAwsScope (App options) where - awsScopeL = lens appAwsScope $ \x y -> x { appAwsScope = y } + awsScopeL = lens appAwsScope $ \x y -> x {appAwsScope = y} instance HasAwsEnv (App options) where - awsEnvL = lens appAwsEnv $ \x y -> x { appAwsEnv = y } + awsEnvL = lens appAwsEnv $ \x y -> x {appAwsEnv = y} instance HasDirectoryOption options => HasDirectoryOption (App options) where directoryOptionL = optionsL . directoryOptionL @@ -87,14 +87,16 @@ runAppT runAppT options f = do envLogSettings <- liftIO - . LoggingEnv.parseWith - . setLogSettingsConcurrency (Just 1) - $ defaultLogSettings - - logger <- newLogger $ adjustLogSettings - (options ^. colorOptionL) - (options ^. verboseOptionL) - envLogSettings + . LoggingEnv.parseWith + . setLogSettingsConcurrency (Just 1) + $ defaultLogSettings + + logger <- + newLogger + $ adjustLogSettings + (options ^. colorOptionL) + (options ^. verboseOptionL) + envLogSettings app <- runResourceT $ runLoggerLoggingT logger $ do aws <- runReaderT (handleAutoSSO options awsEnvDiscover) logger diff --git a/src/Stackctl/ColorOption.hs b/src/Stackctl/ColorOption.hs index 6785ccd..8ac98af 100644 --- a/src/Stackctl/ColorOption.hs +++ b/src/Stackctl/ColorOption.hs @@ -1,23 +1,25 @@ module Stackctl.ColorOption - ( ColorOption(..) - , HasColorOption(..) + ( ColorOption (..) + , HasColorOption (..) , colorOption ) where import Stackctl.Prelude import Blammo.Logging.LogSettings -import Data.Semigroup (Last(..)) +import Data.Semigroup (Last (..)) import Options.Applicative newtype ColorOption = ColorOption { unColorOption :: LogColor } - deriving Semigroup via Last ColorOption + deriving (Semigroup) via Last ColorOption class HasColorOption env where colorOptionL :: Lens' env (Maybe ColorOption) colorOption :: Parser ColorOption -colorOption = option (eitherReader $ fmap ColorOption . readLogColor) $ mconcat - [long "color", help "When to colorize output", metavar "auto|always|never"] +colorOption = + option (eitherReader $ fmap ColorOption . readLogColor) + $ mconcat + [long "color", help "When to colorize output", metavar "auto|always|never"] diff --git a/src/Stackctl/Colors.hs b/src/Stackctl/Colors.hs index 14b50cd..b7283d2 100644 --- a/src/Stackctl/Colors.hs +++ b/src/Stackctl/Colors.hs @@ -1,6 +1,6 @@ -- | Facilities for colorizing output module Stackctl.Colors - ( Colors(..) + ( Colors (..) , getColorsStdout , getColorsLogger , noColors @@ -9,8 +9,8 @@ module Stackctl.Colors import Stackctl.Prelude import Blammo.Logging.Colors -import Blammo.Logging.Logger import Blammo.Logging.LogSettings (shouldColorHandle) +import Blammo.Logging.Logger -- | Return 'Colors' based on options and 'stdout' getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors diff --git a/src/Stackctl/Commands.hs b/src/Stackctl/Commands.hs index 2a24e17..bad0cb3 100644 --- a/src/Stackctl/Commands.hs +++ b/src/Stackctl/Commands.hs @@ -25,12 +25,13 @@ cat , HasAutoSSOOption options ) => Subcommand options CatOptions -cat = Subcommand - { name = "cat" - , description = "Pretty-print specifications" - , parse = parseCatOptions - , run = runAppSubcommand runCat - } +cat = + Subcommand + { name = "cat" + , description = "Pretty-print specifications" + , parse = parseCatOptions + , run = runAppSubcommand runCat + } capture :: ( HasColorOption options @@ -39,12 +40,13 @@ capture , HasAutoSSOOption options ) => Subcommand options CaptureOptions -capture = Subcommand - { name = "capture" - , description = "Capture deployed Stacks as specifications" - , parse = parseCaptureOptions - , run = runAppSubcommand runCapture - } +capture = + Subcommand + { name = "capture" + , description = "Capture deployed Stacks as specifications" + , parse = parseCaptureOptions + , run = runAppSubcommand runCapture + } changes :: ( HasColorOption options @@ -54,12 +56,13 @@ changes , HasAutoSSOOption options ) => Subcommand options ChangesOptions -changes = Subcommand - { name = "changes" - , description = "Review changes between specification and deployed state" - , parse = parseChangesOptions - , run = runAppSubcommand runChanges - } +changes = + Subcommand + { name = "changes" + , description = "Review changes between specification and deployed state" + , parse = parseChangesOptions + , run = runAppSubcommand runChanges + } deploy :: ( HasColorOption options @@ -69,12 +72,13 @@ deploy , HasAutoSSOOption options ) => Subcommand options DeployOptions -deploy = Subcommand - { name = "deploy" - , description = "Deploy specifications" - , parse = parseDeployOptions - , run = runAppSubcommand runDeploy - } +deploy = + Subcommand + { name = "deploy" + , description = "Deploy specifications" + , parse = parseDeployOptions + , run = runAppSubcommand runDeploy + } list :: ( HasColorOption options @@ -84,17 +88,19 @@ list , HasAutoSSOOption options ) => Subcommand options ListOptions -list = Subcommand - { name = "ls" - , description = "List specifications" - , parse = parseListOptions - , run = runAppSubcommand runList - } +list = + Subcommand + { name = "ls" + , description = "List specifications" + , parse = parseListOptions + , run = runAppSubcommand runList + } version :: Subcommand options () -version = Subcommand - { name = "version" - , description = "Output the version" - , parse = pure () - , run = \() _ -> logVersion - } +version = + Subcommand + { name = "version" + , description = "Output the version" + , parse = pure () + , run = \() _ -> logVersion + } diff --git a/src/Stackctl/Config.hs b/src/Stackctl/Config.hs index aedac47..925a6ea 100644 --- a/src/Stackctl/Config.hs +++ b/src/Stackctl/Config.hs @@ -1,10 +1,10 @@ module Stackctl.Config - ( Config(..) + ( Config (..) , configParameters , configTags , emptyConfig - , HasConfig(..) - , ConfigError(..) + , HasConfig (..) + , ConfigError (..) , loadConfigOrExit , loadConfigFromBytes , applyConfig @@ -25,8 +25,8 @@ data Config = Config { required_version :: Maybe RequiredVersion , defaults :: Maybe Defaults } - deriving stock Generic - deriving anyclass FromJSON + deriving stock (Generic) + deriving anyclass (FromJSON) configParameters :: Config -> Maybe ParametersYaml configParameters = parameters <=< defaults @@ -41,8 +41,8 @@ data Defaults = Defaults { parameters :: Maybe ParametersYaml , tags :: Maybe TagsYaml } - deriving stock Generic - deriving anyclass FromJSON + deriving stock (Generic) + deriving anyclass (FromJSON) class HasConfig env where configL :: Lens' env Config @@ -54,7 +54,7 @@ data ConfigError = ConfigInvalidYaml Yaml.ParseException | ConfigInvalid (NonEmpty Text) | ConfigVersionNotSatisfied RequiredVersion Version - deriving stock Show + deriving stock (Show) configErrorMessage :: ConfigError -> Message configErrorMessage = \case @@ -73,9 +73,10 @@ loadConfigOrExit = either die pure =<< loadConfig exitFailure loadConfig :: MonadIO m => m (Either ConfigError Config) -loadConfig = runExceptT $ getConfigFile >>= \case - Nothing -> pure emptyConfig - Just cf -> loadConfigFrom cf +loadConfig = + runExceptT $ getConfigFile >>= \case + Nothing -> pure emptyConfig + Just cf -> loadConfigFrom cf loadConfigFrom :: (MonadIO m, MonadError ConfigError m) => FilePath -> m Config loadConfigFrom path = loadConfigFromBytes =<< liftIO (readFileBinary path) @@ -91,16 +92,19 @@ loadConfigFromBytes bs = do $ ConfigVersionNotSatisfied rv Paths.version applyConfig :: Config -> StackSpecYaml -> StackSpecYaml -applyConfig config ss@StackSpecYaml {..} = ss - { ssyParameters = configParameters config <> ssyParameters - , ssyTags = configTags config <> ssyTags - } +applyConfig config ss@StackSpecYaml {..} = + ss + { ssyParameters = configParameters config <> ssyParameters + , ssyTags = configTags config <> ssyTags + } getConfigFile :: MonadIO m => m (Maybe FilePath) -getConfigFile = listToMaybe <$> filterM - doesFileExist - [ ".stackctl" "config" <.> "yaml" - , ".stackctl" "config" <.> "yml" - , ".stackctl" <.> "yaml" - , ".stackctl" <.> "yml" - ] +getConfigFile = + listToMaybe + <$> filterM + doesFileExist + [ ".stackctl" "config" <.> "yaml" + , ".stackctl" "config" <.> "yml" + , ".stackctl" <.> "yaml" + , ".stackctl" <.> "yml" + ] diff --git a/src/Stackctl/Config/RequiredVersion.hs b/src/Stackctl/Config/RequiredVersion.hs index 930d7b5..0d83a22 100644 --- a/src/Stackctl/Config/RequiredVersion.hs +++ b/src/Stackctl/Config/RequiredVersion.hs @@ -1,11 +1,11 @@ module Stackctl.Config.RequiredVersion - ( RequiredVersion(..) - , RequiredVersionOp(..) + ( RequiredVersion (..) + , RequiredVersionOp (..) , requiredVersionToText , requiredVersionFromText , isRequiredVersionSatisfied - -- * Exported for testing + -- * Exported for testing , (=~) ) where @@ -39,8 +39,10 @@ instance ToJSON RequiredVersion where requiredVersionToText :: RequiredVersion -> Text requiredVersionToText RequiredVersion {..} = - requiredVersionOpToText requiredVersionOp <> " " <> pack - (showVersion requiredVersionCompareWith) + requiredVersionOpToText requiredVersionOp + <> " " + <> pack + (showVersion requiredVersionCompareWith) requiredVersionFromText :: Text -> Either String RequiredVersion requiredVersionFromText = fromWords . T.words @@ -78,12 +80,14 @@ requiredVersionFromText = fromWords . T.words $ note ("Failed to parse as a version " <> s) $ NE.nonEmpty $ readP_to_S Version.parseVersion s - where s = unpack t + where + s = unpack t isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool isRequiredVersionSatisfied RequiredVersion {..} = (`requiredVersionCompare` requiredVersionCompareWith) - where requiredVersionCompare = requiredVersionOpCompare requiredVersionOp + where + requiredVersionCompare = requiredVersionOpCompare requiredVersionOp data RequiredVersionOp = RequiredVersionEQ diff --git a/src/Stackctl/DirectoryOption.hs b/src/Stackctl/DirectoryOption.hs index b9d5e3d..a156a84 100644 --- a/src/Stackctl/DirectoryOption.hs +++ b/src/Stackctl/DirectoryOption.hs @@ -1,22 +1,22 @@ module Stackctl.DirectoryOption - ( DirectoryOption(..) + ( DirectoryOption (..) , defaultDirectoryOption - , HasDirectoryOption(..) + , HasDirectoryOption (..) , envDirectoryOption , directoryOption ) where import Stackctl.Prelude -import Data.Semigroup (Last(..)) +import Data.Semigroup (Last (..)) import qualified Env import Options.Applicative newtype DirectoryOption = DirectoryOption { unDirectoryOption :: FilePath } - deriving newtype IsString - deriving Semigroup via Last DirectoryOption + deriving newtype (IsString) + deriving (Semigroup) via Last DirectoryOption defaultDirectoryOption :: DirectoryOption defaultDirectoryOption = "." @@ -28,14 +28,17 @@ instance HasDirectoryOption DirectoryOption where directoryOptionL = id envDirectoryOption :: Env.Parser Env.Error DirectoryOption -envDirectoryOption = Env.var (Env.str <=< Env.nonempty) "DIRECTORY" - $ Env.help "Operate on specifications in this directory" +envDirectoryOption = + Env.var (Env.str <=< Env.nonempty) "DIRECTORY" + $ Env.help "Operate on specifications in this directory" directoryOption :: Parser DirectoryOption -directoryOption = option str $ mconcat - [ short 'd' - , long "directory" - , metavar "PATH" - , help "Operate on specifications in PATH" - , action "directory" - ] +directoryOption = + option str + $ mconcat + [ short 'd' + , long "directory" + , metavar "PATH" + , help "Operate on specifications in PATH" + , action "directory" + ] diff --git a/src/Stackctl/FilterOption.hs b/src/Stackctl/FilterOption.hs index bb2f1e3..985dfbe 100644 --- a/src/Stackctl/FilterOption.hs +++ b/src/Stackctl/FilterOption.hs @@ -1,7 +1,7 @@ module Stackctl.FilterOption ( FilterOption , defaultFilterOption - , HasFilterOption(..) + , HasFilterOption (..) , envFilterOption , filterOption , filterOptionFromPaths @@ -13,11 +13,11 @@ module Stackctl.FilterOption import Stackctl.Prelude import qualified Data.List.NonEmpty as NE -import Data.Semigroup (Last(..)) +import Data.Semigroup (Last (..)) import qualified Data.Text as T import qualified Env import Options.Applicative -import Stackctl.AWS.CloudFormation (StackName(..)) +import Stackctl.AWS.CloudFormation (StackName (..)) import Stackctl.StackSpec import System.FilePath (hasExtension) import System.FilePath.Glob @@ -25,7 +25,7 @@ import System.FilePath.Glob newtype FilterOption = FilterOption { unFilterOption :: NonEmpty Pattern } - deriving Semigroup via Last FilterOption + deriving (Semigroup) via Last FilterOption instance ToJSON FilterOption where toJSON = toJSON . showFilterOption @@ -48,11 +48,13 @@ envFilterOption items = var "FILTERS" <|> var "FILTER" <> " by patterns" filterOption :: String -> Parser FilterOption -filterOption items = option (eitherReader readFilterOption) $ mconcat - [ long "filter" - , metavar "PATTERN[,PATTERN]" - , help $ "Filter " <> items <> " to match PATTERN(s)" - ] +filterOption items = + option (eitherReader readFilterOption) + $ mconcat + [ long "filter" + , metavar "PATTERN[,PATTERN]" + , help $ "Filter " <> items <> " to match PATTERN(s)" + ] filterOptionFromPaths :: NonEmpty FilePath -> FilterOption filterOptionFromPaths = FilterOption . fmap compile @@ -83,7 +85,8 @@ expandPatterns t = map compile $ s : expanded readFilterOption :: String -> Either String FilterOption readFilterOption = note err . filterOptionFromText . pack - where err = "Must be non-empty, comma-separated list of non-empty patterns" + where + err = "Must be non-empty, comma-separated list of non-empty patterns" showFilterOption :: FilterOption -> String showFilterOption = @@ -104,8 +107,9 @@ filterStackSpecs fo = filter $ \spec -> any (`matchStackSpec` spec) $ unFilterOption fo matchStackSpec :: Pattern -> StackSpec -> Bool -matchStackSpec p spec = or - [ match p $ unpack $ unStackName $ stackSpecStackName spec - , match p $ stackSpecStackFile spec - , match p $ stackSpecTemplateFile spec - ] +matchStackSpec p spec = + or + [ match p $ unpack $ unStackName $ stackSpecStackName spec + , match p $ stackSpecStackFile spec + , match p $ stackSpecTemplateFile spec + ] diff --git a/src/Stackctl/Options.hs b/src/Stackctl/Options.hs index f9b279b..ba3f927 100644 --- a/src/Stackctl/Options.hs +++ b/src/Stackctl/Options.hs @@ -22,17 +22,17 @@ data Options = Options , oVerbose :: Verbosity , oAutoSSO :: Maybe AutoSSOOption } - deriving stock Generic - deriving Semigroup via GenericSemigroupMonoid Options + deriving stock (Generic) + deriving (Semigroup) via GenericSemigroupMonoid Options directoryL :: Lens' Options (Maybe DirectoryOption) -directoryL = lens oDirectory $ \x y -> x { oDirectory = y } +directoryL = lens oDirectory $ \x y -> x {oDirectory = y} filterL :: Lens' Options (Maybe FilterOption) -filterL = lens oFilter $ \x y -> x { oFilter = y } +filterL = lens oFilter $ \x y -> x {oFilter = y} autoSSOL :: Lens' Options (Maybe AutoSSOOption) -autoSSOL = lens oAutoSSO $ \x y -> x { oAutoSSO = y } +autoSSOL = lens oAutoSSO $ \x y -> x {oAutoSSO = y} instance HasDirectoryOption Options where directoryOptionL = directoryL . maybeLens defaultDirectoryOption @@ -41,10 +41,10 @@ instance HasFilterOption Options where filterOptionL = filterL . maybeLens defaultFilterOption instance HasColorOption Options where - colorOptionL = lens oColor $ \x y -> x { oColor = y } + colorOptionL = lens oColor $ \x y -> x {oColor = y} instance HasVerboseOption Options where - verboseOptionL = lens oVerbose $ \x y -> x { oVerbose = y } + verboseOptionL = lens oVerbose $ \x y -> x {oVerbose = y} instance HasAutoSSOOption Options where autoSSOOptionL = autoSSOL . maybeLens defaultAutoSSOOption @@ -52,19 +52,22 @@ instance HasAutoSSOOption Options where -- brittany-disable-next-binding envParser :: Env.Parser Env.Error Options -envParser = Env.prefixed "STACKCTL_" $ Options - <$> optional envDirectoryOption - <*> optional (envFilterOption "specifications") - <*> pure mempty -- use LOG_COLOR - <*> pure mempty -- use LOG_LEVEL - <*> optional envAutoSSOOption +envParser = + Env.prefixed "STACKCTL_" + $ Options + <$> optional envDirectoryOption + <*> optional (envFilterOption "specifications") + <*> pure mempty -- use LOG_COLOR + <*> pure mempty -- use LOG_LEVEL + <*> optional envAutoSSOOption -- brittany-disable-next-binding optionsParser :: Parser Options -optionsParser = Options - <$> optional directoryOption - <*> optional (filterOption "specifications") - <*> optional colorOption - <*> verboseOption - <*> optional autoSSOOption +optionsParser = + Options + <$> optional directoryOption + <*> optional (filterOption "specifications") + <*> optional colorOption + <*> verboseOption + <*> optional autoSSOOption diff --git a/src/Stackctl/ParameterOption.hs b/src/Stackctl/ParameterOption.hs index e579c9b..ea53730 100644 --- a/src/Stackctl/ParameterOption.hs +++ b/src/Stackctl/ParameterOption.hs @@ -9,12 +9,14 @@ import Options.Applicative import Stackctl.AWS.CloudFormation (Parameter, makeParameter) parameterOption :: Parser Parameter -parameterOption = option (eitherReader readParameter) $ mconcat - [ short 'p' - , long "parameter" - , metavar "KEY=[VALUE]" - , help "Override the given Parameter for this operation" - ] +parameterOption = + option (eitherReader readParameter) + $ mconcat + [ short 'p' + , long "parameter" + , metavar "KEY=[VALUE]" + , help "Override the given Parameter for this operation" + ] readParameter :: String -> Either String Parameter readParameter s = case T.breakOn "=" t of @@ -22,4 +24,5 @@ readParameter s = case T.breakOn "=" t of (k, _) | T.null k -> Left $ "Empty key (" <> s <> ")" (k, "=") -> Right $ makeParameter k $ Just "" (k, v) -> Right $ makeParameter k $ Just $ T.drop 1 v - where t = pack s + where + t = pack s diff --git a/src/Stackctl/Prelude.hs b/src/Stackctl/Prelude.hs index 307b834..614ec85 100644 --- a/src/Stackctl/Prelude.hs +++ b/src/Stackctl/Prelude.hs @@ -5,7 +5,7 @@ module Stackctl.Prelude ) where import RIO as X hiding - ( LogLevel(..) + ( LogLevel (..) , LogSource , logDebug , logDebugS @@ -21,10 +21,15 @@ import RIO as X hiding import Blammo.Logging as X import Control.Error.Util as X (hush, note) -import Data.Aeson as X (ToJSON(..), object) +import Data.Aeson as X (ToJSON (..), object) import Data.Text as X (pack, unpack) import System.FilePath as X - (dropExtension, takeBaseName, takeDirectory, (<.>), ()) + ( dropExtension + , takeBaseName + , takeDirectory + , (<.>) + , () + ) import UnliftIO.Directory as X (withCurrentDirectory) {-# ANN module ("HLint: ignore Avoid restricted alias" :: String) #-} diff --git a/src/Stackctl/RemovedStack.hs b/src/Stackctl/RemovedStack.hs index 77b2086..3c3ef14 100644 --- a/src/Stackctl/RemovedStack.hs +++ b/src/Stackctl/RemovedStack.hs @@ -5,7 +5,7 @@ module Stackctl.RemovedStack import Stackctl.Prelude import Control.Error.Util (hoistMaybe) -import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) +import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Stackctl.AWS.CloudFormation import Stackctl.AWS.Core import Stackctl.AWS.Scope diff --git a/src/Stackctl/Spec/Capture.hs b/src/Stackctl/Spec/Capture.hs index 557d103..0771783 100644 --- a/src/Stackctl/Spec/Capture.hs +++ b/src/Stackctl/Spec/Capture.hs @@ -1,5 +1,5 @@ module Stackctl.Spec.Capture - ( CaptureOptions(..) + ( CaptureOptions (..) , parseCaptureOptions , runCapture ) where @@ -27,37 +27,51 @@ data CaptureOptions = CaptureOptions -- brittany-disable-next-binding parseCaptureOptions :: Parser CaptureOptions -parseCaptureOptions = 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" - ))) - <*> flag TemplateFormatYaml TemplateFormatJson - ( long "no-flip" - <> help "Don't flip JSON templates to Yaml" +parseCaptureOptions = + 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" + ) + ) + ) + <*> flag + TemplateFormatYaml + TemplateFormatJson + ( long "no-flip" + <> help "Don't flip JSON templates to Yaml" ) <*> strArgument - ( metavar "STACK" - <> help "Name of deployed Stack to capture" + ( metavar "STACK" + <> help "Name of deployed Stack to capture" ) runCapture @@ -76,28 +90,31 @@ runCapture runCapture CaptureOptions {..} = do let setScopeName scope = - maybe scope (\name -> scope { awsAccountName = name }) scoAccountName + maybe scope (\name -> scope {awsAccountName = name}) scoAccountName generate' stack template path templatePath = do let stackName = StackName $ stack ^. stack_stackName templateBody = templateBodyFromValue template - void $ local (awsScopeL %~ setScopeName) $ generate Generate - { gDescription = stackDescription stack - , gDepends = scoDepends - , gActions = Nothing - , gParameters = parameters stack - , gCapabilities = capabilities stack - , gTags = tags stack - , gSpec = case path of - Nothing -> GenerateSpec stackName - Just sp -> GenerateSpecTo stackName sp - , gTemplate = case templatePath of - Nothing -> GenerateTemplate templateBody scoTemplateFormat - Just tp -> GenerateTemplateTo templateBody tp - , gOverwrite = False - } + void + $ local (awsScopeL %~ setScopeName) + $ generate + Generate + { gDescription = stackDescription stack + , gDepends = scoDepends + , gActions = Nothing + , gParameters = parameters stack + , gCapabilities = capabilities stack + , gTags = tags stack + , gSpec = case path of + Nothing -> GenerateSpec stackName + Just sp -> GenerateSpecTo stackName sp + , gTemplate = case templatePath of + Nothing -> GenerateTemplate templateBody scoTemplateFormat + Just tp -> GenerateTemplateTo templateBody tp + , gOverwrite = False + } results <- awsCloudFormationGetStackNamesMatching scoStackName @@ -108,7 +125,6 @@ runCapture CaptureOptions {..} = do <> pack (decompile scoStackName) :# [] exitFailure - [stackName] -> do stack <- awsCloudFormationDescribeStack stackName template <- awsCloudFormationGetTemplate stackName diff --git a/src/Stackctl/Spec/Cat.hs b/src/Stackctl/Spec/Cat.hs index 4a1235d..b438326 100644 --- a/src/Stackctl/Spec/Cat.hs +++ b/src/Stackctl/Spec/Cat.hs @@ -1,5 +1,5 @@ module Stackctl.Spec.Cat - ( CatOptions(..) + ( CatOptions (..) , parseCatOptions , runCat ) where @@ -21,7 +21,7 @@ import Stackctl.AWS import Stackctl.AWS.Scope import Stackctl.Colors import Stackctl.Config (HasConfig) -import Stackctl.DirectoryOption (HasDirectoryOption(..), unDirectoryOption) +import Stackctl.DirectoryOption (HasDirectoryOption (..), unDirectoryOption) import Stackctl.FilterOption (HasFilterOption) import Stackctl.Spec.Discover import Stackctl.StackSpec @@ -37,20 +37,21 @@ data CatOptions = CatOptions -- brittany-disable-next-binding parseCatOptions :: Parser CatOptions -parseCatOptions = 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" - ) +parseCatOptions = + 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 @@ -114,21 +115,23 @@ specTree = map (second groupRegion) . groupAccount groupRegion = groupTo (stackSpecPathRegion . stackSpecSpecPath) groupAccount :: [StackSpec] -> [((AccountId, Text), [StackSpec])] - groupAccount = groupTo - ((stackSpecPathAccountId &&& stackSpecPathAccountName) . stackSpecSpecPath) + 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)] - , maybe [] ppDescription ssyDescription - , [cyan "Template" <> ": " <> green (pack ssyTemplate)] - , ppObject "Parameters" parametersYamlKVs ssyParameters - , ppList "Capabilities" ppCapabilities ssyCapabilities - , ppObject "Tags" tagsYamlKVs ssyTags - ] +prettyPrintStackSpecYaml Colors {..} name StackSpecYaml {..} = + concat + [ [cyan "Name" <> ": " <> green (unStackName name)] + , maybe [] ppDescription ssyDescription + , [cyan "Template" <> ": " <> green (pack ssyTemplate)] + , ppObject "Parameters" parametersYamlKVs ssyParameters + , ppList "Capabilities" ppCapabilities ssyCapabilities + , ppObject "Tags" tagsYamlKVs ssyTags + ] where ppObject :: Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text] ppObject label f mA = fromMaybe [] $ do @@ -136,10 +139,10 @@ prettyPrintStackSpecYaml Colors {..} name StackSpecYaml {..} = concat pure $ [cyan label <> ":"] <> map - (\(k, mV) -> - " " <> cyan k <> ":" <> maybe "" (\v -> " " <> green v) mV - ) - kvs + ( \(k, mV) -> + " " <> cyan k <> ":" <> maybe "" (\v -> " " <> green v) mV + ) + kvs ppList :: Text -> (a -> [Text]) -> Maybe a -> [Text] ppList label f = maybe [] (((cyan label <> ":") :) . f) @@ -152,9 +155,13 @@ parametersYamlKVs :: ParametersYaml -> [(Text, Maybe Text)] parametersYamlKVs = mapMaybe parameterYamlKV . unParametersYaml parameterYamlKV :: ParameterYaml -> Maybe (Text, Maybe Text) -parameterYamlKV py = (,) <$> (p ^. parameter_parameterKey) <*> pure - (p ^. parameter_parameterValue) - where p = unParameterYaml py +parameterYamlKV py = + (,) + <$> (p ^. parameter_parameterKey) + <*> pure + (p ^. parameter_parameterValue) + where + p = unParameterYaml py tagsYamlKVs :: TagsYaml -> [(Text, Maybe Text)] tagsYamlKVs = map (tagKV . unTagYaml) . unTagsYaml @@ -163,12 +170,13 @@ tagKV :: Tag -> (Text, Maybe Text) tagKV tg = (tg ^. tag_key, tg ^. tag_value . to Just) prettyPrintTemplate :: Colors -> Value -> [Text] -prettyPrintTemplate Colors {..} val = concat - [ displayTextProperty "Description" - , displayObjectProperty "Parameters" - , displayObjectProperty "Resources" - , displayObjectProperty "Outputs" - ] +prettyPrintTemplate Colors {..} val = + concat + [ displayTextProperty "Description" + , displayObjectProperty "Parameters" + , displayObjectProperty "Resources" + , displayObjectProperty "Outputs" + ] where displayTextProperty :: Text -> [Text] displayTextProperty = displayPropertyWith @@ -184,7 +192,8 @@ prettyPrintTemplate Colors {..} val = concat displayPropertyWith :: (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text] displayPropertyWith f k = cyan k <> ": " : fromMaybe [] displayValue - where displayValue = val ^? key (Key.fromText k) . _JSON . to f + where + displayValue = val ^? key (Key.fromText k) . _JSON . to f putBoxed :: MonadIO m => Int -> [Text] -> m () putBoxed n xs = do @@ -194,4 +203,5 @@ putBoxed n xs = do put :: MonadIO m => Int -> Text -> m () put n = liftIO . T.putStrLn . (indent <>) - where indent = mconcat $ replicate n " " + where + indent = mconcat $ replicate n " " diff --git a/src/Stackctl/Spec/Changes.hs b/src/Stackctl/Spec/Changes.hs index 19f8ff6..7ff6ebe 100644 --- a/src/Stackctl/Spec/Changes.hs +++ b/src/Stackctl/Spec/Changes.hs @@ -1,5 +1,5 @@ module Stackctl.Spec.Changes - ( ChangesOptions(..) + ( ChangesOptions (..) , parseChangesOptions , runChanges ) where @@ -34,16 +34,20 @@ data ChangesOptions = ChangesOptions -- brittany-disable-next-binding parseChangesOptions :: Parser ChangesOptions -parseChangesOptions = ChangesOptions - <$> formatOption - <*> omitFullOption - <*> many parameterOption - <*> many tagOption - <*> optional (argument str - ( metavar "PATH" - <> help "Write changes summary to PATH" - <> action "file" - )) +parseChangesOptions = + ChangesOptions + <$> formatOption + <*> omitFullOption + <*> many parameterOption + <*> many tagOption + <*> optional + ( argument + str + ( metavar "PATH" + <> help "Write changes summary to PATH" + <> action "file" + ) + ) runChanges :: ( MonadMask m @@ -66,12 +70,11 @@ runChanges ChangesOptions {..} = do colors <- case scoOutput of Nothing -> getColorsLogger - Just{} -> pure noColors + Just {} -> pure noColors - let - write formatted = case scoOutput of - Nothing -> pushLoggerLn formatted - Just p -> liftIO $ T.appendFile p $ formatted <> "\n" + let write formatted = case scoOutput of + Nothing -> pushLoggerLn formatted + Just p -> liftIO $ T.appendFile p $ formatted <> "\n" specs <- discoverSpecs diff --git a/src/Stackctl/Spec/Changes/Format.hs b/src/Stackctl/Spec/Changes/Format.hs index 3447c8a..0ba7b16 100644 --- a/src/Stackctl/Spec/Changes/Format.hs +++ b/src/Stackctl/Spec/Changes/Format.hs @@ -1,7 +1,7 @@ module Stackctl.Spec.Changes.Format - ( Format(..) + ( Format (..) , formatOption - , OmitFull(..) + , OmitFull (..) , omitFullOption , formatChangeSet , formatRemovedStack @@ -25,13 +25,15 @@ data OmitFull | IncludeFull formatOption :: Parser Format -formatOption = option (eitherReader readFormat) $ mconcat - [ short 'f' - , long "format" - , help "Format to output changes in" - , value FormatTTY - , showDefaultWith showFormat - ] +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 @@ -47,10 +49,13 @@ showFormat = \case -- brittany-disable-next-binding omitFullOption :: Parser OmitFull -omitFullOption = flag IncludeFull OmitFull - ( long "no-include-full" - <> help "Don't include full ChangeSet JSON details" - ) +omitFullOption = + flag + IncludeFull + OmitFull + ( long "no-include-full" + <> help "Don't include full ChangeSet JSON details" + ) formatChangeSet :: Colors -> OmitFull -> Text -> Format -> Maybe ChangeSet -> Text @@ -62,16 +67,18 @@ formatRemovedStack :: Colors -> Format -> Stack -> Text formatRemovedStack Colors {..} format stack = case format of FormatTTY -> red "DELETE" <> " stack " <> cyan name FormatPullRequest -> ":x: This PR will **delete** the stack `" <> name <> "`" - where name = stack ^. stack_stackName + where + name = stack ^. stack_stackName 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) + ("\n" <>) $ (<> "\n") $ mconcat $ ("Changes for " <> cyan name <> ":") + : map + (("\n " <>) . formatResourceChange) + (NE.toList rcs) where rChanges = do cs <- mChangeSet @@ -143,31 +150,32 @@ commentBody omitFull cs rcs = ] <> map commentTableRow (NE.toList rcs) <> case omitFull of - OmitFull -> [] - IncludeFull -> - [ "\n" - , "\n
" - , "\nFull changes" - , "\n" - , "\n```json" - , "\n" <> changeSetJSON cs - , "\n```" - , "\n" - , "\n
" - ] + OmitFull -> [] + IncludeFull -> + [ "\n" + , "\n
" + , "\nFull changes" + , "\n" + , "\n```json" + , "\n" <> changeSetJSON cs + , "\n```" + , "\n" + , "\n
" + ] 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 <> " " - , "|" - ] +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 = diff --git a/src/Stackctl/Spec/Deploy.hs b/src/Stackctl/Spec/Deploy.hs index 1a055e7..f3518d6 100644 --- a/src/Stackctl/Spec/Deploy.hs +++ b/src/Stackctl/Spec/Deploy.hs @@ -1,6 +1,6 @@ module Stackctl.Spec.Deploy - ( DeployOptions(..) - , DeployConfirmation(..) + ( DeployOptions (..) + , DeployConfirmation (..) , parseDeployOptions , runDeploy ) where @@ -11,9 +11,9 @@ import Blammo.Logging.Logger (pushLoggerLn) import qualified Data.Text as T import Data.Time (defaultTimeLocale, formatTime, utcToLocalZonedTime) import Options.Applicative -import Stackctl.Action import Stackctl.AWS hiding (action) import Stackctl.AWS.Scope +import Stackctl.Action import Stackctl.Colors import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption (HasDirectoryOption) @@ -39,27 +39,34 @@ data DeployOptions = DeployOptions -- brittany-disable-next-binding parseDeployOptions :: Parser DeployOptions -parseDeployOptions = DeployOptions - <$> many parameterOption - <*> many tagOption - <*> optional (strOption - ( long "save-change-sets" - <> metavar "DIRECTORY" - <> help "Save executed changesets to DIRECTORY" - <> action "directory" - )) - <*> flag DeployWithConfirmation DeployWithoutConfirmation - ( long "no-confirm" - <> help "Don't confirm changes before executing" - ) - <*> (not <$> switch - ( long "no-remove" - <> help "Don't delete removed Stacks" - )) - <*> switch - ( long "clean" - <> help "Remove all changesets from Stack after deploy" - ) +parseDeployOptions = + DeployOptions + <$> many parameterOption + <*> many tagOption + <*> optional + ( strOption + ( long "save-change-sets" + <> metavar "DIRECTORY" + <> help "Save executed changesets to DIRECTORY" + <> action "directory" + ) + ) + <*> flag + DeployWithConfirmation + DeployWithoutConfirmation + ( long "no-confirm" + <> help "Don't confirm changes before executing" + ) + <*> ( not + <$> switch + ( long "no-remove" + <> help "Don't delete removed Stacks" + ) + ) + <*> switch + ( long "clean" + <> help "Remove all changesets from Stack after deploy" + ) runDeploy :: ( MonadMask m @@ -131,12 +138,13 @@ deleteRemovedStack confirmation stack = do DeployWithoutConfirmation -> pure () deleteStack stackName - where stackName = StackName $ stack ^. stack_stackName + where + stackName = StackName $ stack ^. stack_stackName data DeployConfirmation = DeployWithConfirmation | DeployWithoutConfirmation - deriving stock Eq + deriving stock (Eq) checkIfStackRequiresDeletion :: ( MonadUnliftIO m @@ -156,7 +164,7 @@ checkIfStackRequiresDeletion confirmation stackName = do logWarn $ "Stack must be deleted before proceeding" :# ["status" .= status] when (status == StackStatus_ROLLBACK_FAILED) $ logWarn - "Stack is in ROLLBACK_FAILED. This may require elevated permissions for the delete to succeed" + "Stack is in ROLLBACK_FAILED. This may require elevated permissions for the delete to succeed" case confirmation of DeployWithConfirmation -> promptContinue @@ -176,7 +184,7 @@ deleteStack stackName = do case result of StackDeleteSuccess -> logInfo $ prettyStackDeleteResult result :# [] - StackDeleteFailure{} -> logWarn $ prettyStackDeleteResult result :# [] + StackDeleteFailure {} -> logWarn $ prettyStackDeleteResult result :# [] deployChangeSet :: ( MonadUnliftIO m @@ -218,9 +226,9 @@ deployChangeSet confirmation changeSet = do case result of StackCreateSuccess -> onSuccess - StackCreateFailure{} -> onFailure + StackCreateFailure {} -> onFailure StackUpdateSuccess -> onSuccess - StackUpdateFailure{} -> onFailure + StackUpdateFailure {} -> onFailure where stackName = csStackName changeSet changeSetId = csChangeSetId changeSet @@ -233,7 +241,8 @@ tailStackEventsSince , HasAwsEnv env ) => StackName - -> Maybe Text -- ^ StackEventId + -> Maybe Text + -- ^ StackEventId -> m a tailStackEventsSince stackName mLastId = do colors <- getColorsLogger @@ -251,18 +260,21 @@ tailStackEventsSince stackName mLastId = do 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 - ] + 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 diff --git a/src/Stackctl/Spec/Discover.hs b/src/Stackctl/Spec/Discover.hs index 1793e99..6153ee8 100644 --- a/src/Stackctl/Spec/Discover.hs +++ b/src/Stackctl/Spec/Discover.hs @@ -10,8 +10,8 @@ import qualified Data.List.NonEmpty as NE import Stackctl.AWS import Stackctl.AWS.Scope import Stackctl.Config (HasConfig) -import Stackctl.DirectoryOption (HasDirectoryOption(..), unDirectoryOption) -import Stackctl.FilterOption (HasFilterOption(..), filterStackSpecs) +import Stackctl.DirectoryOption (HasDirectoryOption (..), unDirectoryOption) +import Stackctl.FilterOption (HasFilterOption (..), filterStackSpecs) import Stackctl.StackSpec import Stackctl.StackSpecPath import System.FilePath (isPathSeparator) @@ -51,8 +51,8 @@ discoverSpecs = do specs <- sortStackSpecs - . filterStackSpecs filterOption - <$> traverse (readStackSpec dir) specPaths + . filterStackSpecs filterOption + <$> traverse (readStackSpec dir) specPaths when (null specs) $ logWarn "No specs found" specs <$ logDebug ("Discovered specs" :# ["matched" .= length specs]) diff --git a/src/Stackctl/Spec/Generate.hs b/src/Stackctl/Spec/Generate.hs index c316954..c3b22db 100644 --- a/src/Stackctl/Spec/Generate.hs +++ b/src/Stackctl/Spec/Generate.hs @@ -1,16 +1,16 @@ module Stackctl.Spec.Generate - ( Generate(..) - , GenerateSpec(..) - , GenerateTemplate(..) + ( Generate (..) + , GenerateSpec (..) + , GenerateTemplate (..) , generate - , TemplateFormat(..) + , TemplateFormat (..) ) where import Stackctl.Prelude -import Stackctl.Action import Stackctl.AWS import Stackctl.AWS.Scope +import Stackctl.Action import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption import Stackctl.Spec.Discover (buildSpecPath) @@ -31,18 +31,18 @@ data Generate = Generate } data GenerateSpec - = GenerateSpec StackName - -- ^ Generate at an inferred name - | GenerateSpecTo StackName FilePath - -- ^ Generate to a given path + = -- | Generate at an inferred name + GenerateSpec StackName + | -- | Generate to a given path + GenerateSpecTo StackName FilePath data GenerateTemplate - = GenerateTemplate TemplateBody TemplateFormat - -- ^ Generate at an inferred name - | GenerateTemplateTo TemplateBody FilePath - -- ^ Generate to the given path - | UseExistingTemplate FilePath - -- ^ Assume template exists + = -- | Generate at an inferred name + GenerateTemplate TemplateBody TemplateFormat + | -- | Generate to the given path + GenerateTemplateTo TemplateBody FilePath + | -- | Assume template exists + UseExistingTemplate FilePath data TemplateFormat = TemplateFormatYaml @@ -69,21 +69,22 @@ generate Generate {..} = do GenerateTemplate body format -> ( Just body , case format of - TemplateFormatYaml -> unpack (unStackName stackName) <> ".yaml" - TemplateFormatJson -> unpack (unStackName stackName) <> ".json" + TemplateFormatYaml -> unpack (unStackName stackName) <> ".yaml" + TemplateFormatJson -> unpack (unStackName stackName) <> ".json" ) GenerateTemplateTo body path -> (Just body, path) UseExistingTemplate path -> (Nothing, path) - specYaml = StackSpecYaml - { ssyDescription = gDescription - , ssyTemplate = templatePath - , ssyDepends = gDepends - , ssyActions = gActions - , ssyParameters = parametersYaml . mapMaybe parameterYaml <$> gParameters - , ssyCapabilities = gCapabilities - , ssyTags = tagsYaml . map TagYaml <$> gTags - } + specYaml = + StackSpecYaml + { ssyDescription = gDescription + , ssyTemplate = templatePath + , ssyDepends = gDepends + , ssyActions = gActions + , ssyParameters = parametersYaml . mapMaybe parameterYaml <$> gParameters + , ssyCapabilities = gCapabilities + , ssyTags = tagsYaml . map TagYaml <$> gTags + } dir <- view $ directoryOptionL . to unDirectoryOption specPath <- buildSpecPath stackName stackPath diff --git a/src/Stackctl/Spec/List.hs b/src/Stackctl/Spec/List.hs index d96d117..25369fa 100644 --- a/src/Stackctl/Spec/List.hs +++ b/src/Stackctl/Spec/List.hs @@ -1,5 +1,5 @@ module Stackctl.Spec.List - ( ListOptions(..) + ( ListOptions (..) , parseListOptions , runList ) where @@ -12,7 +12,7 @@ import Stackctl.AWS import Stackctl.AWS.Scope import Stackctl.Colors import Stackctl.Config (HasConfig) -import Stackctl.DirectoryOption (HasDirectoryOption(..)) +import Stackctl.DirectoryOption (HasDirectoryOption (..)) import Stackctl.FilterOption (HasFilterOption) import Stackctl.Spec.Discover import Stackctl.StackSpec diff --git a/src/Stackctl/StackDescription.hs b/src/Stackctl/StackDescription.hs index fc95edc..34920e2 100644 --- a/src/Stackctl/StackDescription.hs +++ b/src/Stackctl/StackDescription.hs @@ -1,12 +1,12 @@ module Stackctl.StackDescription - ( StackDescription(..) + ( StackDescription (..) , addStackDescription ) where import Stackctl.Prelude import Control.Lens ((?~)) -import Data.Aeson (FromJSON, Value(..)) +import Data.Aeson (FromJSON, Value (..)) import qualified Data.Aeson as JSON import Data.Aeson.Lens import Data.ByteString.Char8 as BS8 @@ -28,13 +28,15 @@ addStackDescription mStackDescription body = fromMaybe body $ do decodeUtf8 <$> case bc of BodyContentJSON v -> updateJSON d bs <$ guard (not $ hasDescription v) BodyContentYaml v -> updateYaml d bs <$ guard (not $ hasDescription v) - where bs = encodeUtf8 body + where + bs = encodeUtf8 body getBodyContent :: ByteString -> Maybe BodyContent -getBodyContent body = asum - [ BodyContentJSON . Object <$> JSON.decodeStrict body - , hush $ BodyContentYaml . Object <$> Yaml.decodeEither' body - ] +getBodyContent body = + asum + [ BodyContentJSON . Object <$> JSON.decodeStrict body + , hush $ BodyContentYaml . Object <$> Yaml.decodeEither' body + ] -- Inserting a key is easy to do in Yaml without the parsing round-trip that -- would strip formatting and comments. But updating a key is hard. To avoid diff --git a/src/Stackctl/StackSpec.hs b/src/Stackctl/StackSpec.hs index c7e7d55..8cc7c18 100644 --- a/src/Stackctl/StackSpec.hs +++ b/src/Stackctl/StackSpec.hs @@ -27,14 +27,14 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BSL import Data.List.Extra (nubOrdOn) import qualified Data.Yaml as Yaml -import Stackctl.Action import Stackctl.AWS -import Stackctl.Config (HasConfig(..), applyConfig) +import Stackctl.Action +import Stackctl.Config (HasConfig (..), applyConfig) import Stackctl.Sort import Stackctl.StackSpecPath import Stackctl.StackSpecYaml -import qualified System.FilePath as FilePath import System.FilePath (takeExtension) +import qualified System.FilePath as FilePath import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist) data StackSpec = StackSpec @@ -101,11 +101,12 @@ buildStackSpec -> m StackSpec buildStackSpec dir specPath specBody = do config <- view configL - pure StackSpec - { ssSpecRoot = dir - , ssSpecPath = specPath - , ssSpecBody = applyConfig config specBody - } + pure + StackSpec + { ssSpecRoot = dir + , ssSpecPath = specPath + , ssSpecBody = applyConfig config specBody + } data TemplateBody = TemplateText Text @@ -114,7 +115,7 @@ data TemplateBody newtype UnexpectedTemplateJson = UnexpectedTemplateJson { _unexpectedTemplateJsonExtension :: String } - deriving stock Show + deriving stock (Show) instance Exception UnexpectedTemplateJson where displayException (UnexpectedTemplateJson ext) = @@ -192,14 +193,15 @@ createChangeSet -> [Parameter] -> [Tag] -> m (Either Text (Maybe ChangeSet)) -createChangeSet spec parameters tags = awsCloudFormationCreateChangeSet - (stackSpecStackName spec) - (stackSpecStackDescription spec) - (stackSpecTemplate spec) - (nubOrdOn (^. parameter_parameterKey) $ parameters <> stackSpecParameters spec - ) - (stackSpecCapabilities spec) - (nubOrdOn (^. tag_key) $ tags <> stackSpecTags spec) +createChangeSet spec parameters tags = + awsCloudFormationCreateChangeSet + (stackSpecStackName spec) + (stackSpecStackDescription spec) + (stackSpecTemplate spec) + ( nubOrdOn (^. parameter_parameterKey) $ parameters <> stackSpecParameters spec + ) + (stackSpecCapabilities spec) + (nubOrdOn (^. tag_key) $ tags <> stackSpecTags spec) sortStackSpecs :: [StackSpec] -> [StackSpec] sortStackSpecs = sortByDependencies stackSpecStackName stackSpecDepends diff --git a/src/Stackctl/StackSpecPath.hs b/src/Stackctl/StackSpecPath.hs index bc1c970..a5ce673 100644 --- a/src/Stackctl/StackSpecPath.hs +++ b/src/Stackctl/StackSpecPath.hs @@ -3,7 +3,7 @@ module Stackctl.StackSpecPath ( StackSpecPath - -- * Fields + -- * Fields , stackSpecPathAccountId , stackSpecPathAccountName , stackSpecPathRegion @@ -11,7 +11,7 @@ module Stackctl.StackSpecPath , stackSpecPathBasePath , stackSpecPathFilePath - -- * Construction + -- * Construction , stackSpecPath , stackSpecPathFromFilePath ) where @@ -33,12 +33,13 @@ data StackSpecPath = StackSpecPath deriving stock (Eq, Show) stackSpecPath :: AwsScope -> StackName -> FilePath -> StackSpecPath -stackSpecPath sspAwsScope@AwsScope {..} sspStackName sspPath = StackSpecPath - { sspAwsScope - , sspAccountPathPart - , sspStackName - , sspPath - } +stackSpecPath sspAwsScope@AwsScope {..} sspStackName sspPath = + StackSpecPath + { sspAwsScope + , sspAccountPathPart + , sspStackName + , sspPath + } where sspAccountPathPart = unpack $ unAccountId awsAccountId <> "." <> awsAccountName @@ -71,7 +72,8 @@ stackSpecPathFilePath path = stackSpecPathFromFilePath :: AwsScope - -> FilePath -- ^ Must be relative, @stacks/@ + -> FilePath + -- ^ Must be relative, @stacks/@ -> Either String StackSpecPath stackSpecPathFromFilePath awsScope@AwsScope {..} path = case splitDirectories path of @@ -94,17 +96,17 @@ stackSpecPathFromFilePath awsScope@AwsScope {..} path = 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 - } - + $ 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}@ @@ -116,4 +118,5 @@ parseAccountPath path = case second (T.drop 1) $ T.breakOn "." $ pack path of 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 + where + isAccountId x = T.length x == 12 && T.all isDigit x diff --git a/src/Stackctl/StackSpecYaml.hs b/src/Stackctl/StackSpecYaml.hs index ea10960..bc13edd 100644 --- a/src/Stackctl/StackSpecYaml.hs +++ b/src/Stackctl/StackSpecYaml.hs @@ -17,9 +17,8 @@ -- - Key: -- Value: -- @ --- module Stackctl.StackSpecYaml - ( StackSpecYaml(..) + ( StackSpecYaml (..) , ParametersYaml , parametersYaml , unParametersYaml @@ -29,7 +28,7 @@ module Stackctl.StackSpecYaml , TagsYaml , tagsYaml , unTagsYaml - , TagYaml(..) + , TagYaml (..) ) where import Stackctl.Prelude @@ -40,10 +39,10 @@ import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.Types (typeMismatch) import qualified Data.HashMap.Strict as HashMap -import Data.Monoid (Last(..)) +import Data.Monoid (Last (..)) import qualified Data.Text as T -import Stackctl.Action import Stackctl.AWS +import Stackctl.Action data StackSpecYaml = StackSpecYaml { ssyDescription :: Maybe StackDescription @@ -86,7 +85,7 @@ instance FromJSON ParametersYaml where -- error messages will include "Parameters.{k}". See specs for an example. let parseKey k = ParameterYaml k <$> o .: k ParametersYaml <$> traverse parseKey (KeyMap.keys o) - v@Array{} -> ParametersYaml <$> parseJSON v + v@Array {} -> ParametersYaml <$> parseJSON v v -> typeMismatch err v where err = @@ -164,14 +163,14 @@ instance Semigroup TagsYaml where instance FromJSON TagsYaml where parseJSON = \case Object o -> do - let - parseKey k = do - t <- newTag (Key.toText k) <$> o .: k - pure $ TagYaml t + let parseKey k = do + t <- newTag (Key.toText k) <$> o .: k + pure $ TagYaml t TagsYaml <$> traverse parseKey (KeyMap.keys o) - v@Array{} -> TagsYaml <$> parseJSON v + v@Array {} -> TagsYaml <$> parseJSON v v -> typeMismatch err v - where err = "Object or list of {Key, Value} Objects" + where + err = "Object or list of {Key, Value} Objects" instance ToJSON TagsYaml where toJSON = object . tagsYamlPairs diff --git a/src/Stackctl/Subcommand.hs b/src/Stackctl/Subcommand.hs index ac296e6..83f49fc 100644 --- a/src/Stackctl/Subcommand.hs +++ b/src/Stackctl/Subcommand.hs @@ -1,5 +1,5 @@ module Stackctl.Subcommand - ( Subcommand(..) + ( Subcommand (..) , subcommand , runSubcommand , runSubcommand' @@ -42,12 +42,14 @@ runSubcommand' -> Mod CommandFields (options -> IO a) -> IO a runSubcommand' title parseEnv parseCLI sp = do - (options, act) <- applyEnv - <$> Env.parse (Env.header $ unpack title) parseEnv - <*> execParser (withInfo title $ (,) <$> parseCLI <*> subparser sp) + (options, act) <- + applyEnv + <$> Env.parse (Env.header $ unpack title) parseEnv + <*> execParser (withInfo title $ (,) <$> parseCLI <*> subparser sp) act options - where applyEnv env = first (env <>) + where + applyEnv env = first (env <>) -- | Use this in the 'run' member of a 'Subcommand' that wants 'AppT' -- @@ -60,7 +62,6 @@ runSubcommand' title parseEnv parseCLI sp = do -- runFoo :: (MonadReader env m, HasAws env) => FooOptions -> m () -- runFoo = undefined -- @ --- runAppSubcommand :: ( HasColorOption options , HasVerboseOption options diff --git a/src/Stackctl/TagOption.hs b/src/Stackctl/TagOption.hs index 5988137..0efb80e 100644 --- a/src/Stackctl/TagOption.hs +++ b/src/Stackctl/TagOption.hs @@ -9,12 +9,14 @@ import Options.Applicative import Stackctl.AWS.CloudFormation (Tag, newTag) tagOption :: Parser Tag -tagOption = option (eitherReader readTag) $ mconcat - [ short 't' - , long "tag" - , metavar "KEY=[VALUE]" - , help "Override the given Tag for this operation" - ] +tagOption = + option (eitherReader readTag) + $ mconcat + [ short 't' + , long "tag" + , metavar "KEY=[VALUE]" + , help "Override the given Tag for this operation" + ] readTag :: String -> Either String Tag readTag s = case T.breakOn "=" t of @@ -22,4 +24,5 @@ readTag s = case T.breakOn "=" t of (k, _) | T.null k -> Left $ "Empty key (" <> s <> ")" (k, "=") -> Right $ newTag k "" (k, v) -> Right $ newTag k $ T.drop 1 v - where t = pack s + where + t = pack s diff --git a/src/Stackctl/VerboseOption.hs b/src/Stackctl/VerboseOption.hs index 56443b5..9359c2c 100644 --- a/src/Stackctl/VerboseOption.hs +++ b/src/Stackctl/VerboseOption.hs @@ -1,7 +1,7 @@ module Stackctl.VerboseOption ( Verbosity , verbositySetLogLevels - , HasVerboseOption(..) + , HasVerboseOption (..) , verboseOption ) where @@ -31,8 +31,12 @@ 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)" - ] +verboseOption = + fmap Verbosity + $ many + $ flag' () + $ mconcat + [ short 'v' + , long "verbose" + , help "Increase verbosity (can be passed multiple times)" + ] diff --git a/test/Spec.hs b/test/Spec.hs index 545b063..c5e6791 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,2 @@ -{-# OPTIONS_GHC -fno-warn-missing-export-lists #-} {-# OPTIONS_GHC -F -pgmF hspec-discover #-} +{-# OPTIONS_GHC -fno-warn-missing-export-lists #-} diff --git a/test/Stackctl/AWS/ScopeSpec.hs b/test/Stackctl/AWS/ScopeSpec.hs index 1388177..8dba6f6 100644 --- a/test/Stackctl/AWS/ScopeSpec.hs +++ b/test/Stackctl/AWS/ScopeSpec.hs @@ -12,12 +12,12 @@ import Test.Hspec spec :: Spec spec = do describe "awsScopeSpecStackName" $ do - let - scope = AwsScope - { awsAccountId = AccountId "123" - , awsAccountName = "testing" - , awsRegion = "us-east-1" - } + let scope = + AwsScope + { awsAccountId = AccountId "123" + , awsAccountName = "testing" + , awsRegion = "us-east-1" + } it "parses full paths to stacks in the current scope" $ do awsScopeSpecStackName scope "stacks/123.testing/us-east-1/foo.yaml" diff --git a/test/Stackctl/Config/RequiredVersionSpec.hs b/test/Stackctl/Config/RequiredVersionSpec.hs index 27e2475..7cbfc85 100644 --- a/test/Stackctl/Config/RequiredVersionSpec.hs +++ b/test/Stackctl/Config/RequiredVersionSpec.hs @@ -39,7 +39,6 @@ spec = do it "compares with >=" $ prop (>=) $ Just ">=" it "compares with =~" $ prop (=~) $ Just "=~" - describe "=~" $ do it "treats equal versions as satisfying" $ do makeVersion [1, 2, 3] =~ makeVersion [1, 2, 3] `shouldBe` True @@ -83,4 +82,5 @@ runRequiredVersion -> Either String Bool runRequiredVersion mOperator required current = (`isRequiredVersionSatisfied` current) <$> requiredVersionFromText rvText - where rvText = maybe "" (<> " ") mOperator <> pack (showVersion required) + where + rvText = maybe "" (<> " ") mOperator <> pack (showVersion required) diff --git a/test/Stackctl/ConfigSpec.hs b/test/Stackctl/ConfigSpec.hs index 3950f2e..971c25b 100644 --- a/test/Stackctl/ConfigSpec.hs +++ b/test/Stackctl/ConfigSpec.hs @@ -19,15 +19,15 @@ spec :: Spec spec = do describe "loadConfigFromBytes" $ do it "loads a valid config" $ do - let - result = loadConfigFromLines - [ "required_version: " <> BS8.pack (showVersion Paths.version) - , "defaults:" - , " parameters:" - , " Some: Parameter" - , " tags:" - , " Some: Tag" - ] + let result = + loadConfigFromLines + [ "required_version: " <> BS8.pack (showVersion Paths.version) + , "defaults:" + , " parameters:" + , " Some: Parameter" + , " tags:" + , " Some: Tag" + ] case result of Left err -> do @@ -42,15 +42,16 @@ spec = do describe "applyConfig" $ do it "defaults missing Tags" $ do let - specYaml = StackSpecYaml - { ssyDescription = Nothing - , ssyTemplate = "" - , ssyDepends = Nothing - , ssyActions = Nothing - , ssyParameters = Nothing - , ssyCapabilities = Nothing - , ssyTags = Just $ toTagsYaml [("Hi", "There"), ("Keep", "Me")] - } + specYaml = + StackSpecYaml + { ssyDescription = Nothing + , ssyTemplate = "" + , ssyDepends = Nothing + , ssyActions = Nothing + , ssyParameters = Nothing + , ssyCapabilities = Nothing + , ssyTags = Just $ toTagsYaml [("Hi", "There"), ("Keep", "Me")] + } Right config = loadConfigFromBytes @@ -61,8 +62,9 @@ spec = do Just tags = ssyTags (applyConfig config specYaml) - tags `shouldBe` toTagsYaml - [("From", "Defaults"), ("Hi", "There"), ("Keep", "Me")] + tags + `shouldBe` toTagsYaml + [("From", "Defaults"), ("Hi", "There"), ("Keep", "Me")] loadConfigFromLines :: MonadError ConfigError m => [ByteString] -> m Config loadConfigFromLines = loadConfigFromBytes . mconcat . map (<> "\n") diff --git a/test/Stackctl/FilterOptionSpec.hs b/test/Stackctl/FilterOptionSpec.hs index e905c5d..ed88652 100644 --- a/test/Stackctl/FilterOptionSpec.hs +++ b/test/Stackctl/FilterOptionSpec.hs @@ -91,8 +91,9 @@ spec = do describe "filterOptionFromPaths" $ do it "finds full paths (e.g. as output by generate)" $ do let - option = filterOptionFromPaths - $ pure "stacks/1234567890.test-account/us-east-1/stack.yaml" + option = + filterOptionFromPaths + $ pure "stacks/1234567890.test-account/us-east-1/stack.yaml" specs = [ toSpec "some-name" "stack.yaml" Nothing , toSpec "other-path" "other-stack.yaml" $ Just "x" @@ -102,26 +103,29 @@ spec = do `shouldMatchList` ["some-name"] toSpec :: Text -> FilePath -> Maybe FilePath -> StackSpec -toSpec name path mTemplate = flip runReader emptyConfig - $ buildStackSpec ".platform/specs" specPath specBody +toSpec name path mTemplate = + flip runReader emptyConfig + $ buildStackSpec ".platform/specs" specPath specBody where stackName = StackName name specPath = stackSpecPath scope stackName path - specBody = StackSpecYaml - { ssyDescription = Nothing - , ssyDepends = Nothing - , ssyActions = Nothing - , ssyTemplate = fromMaybe path mTemplate - , ssyParameters = Nothing - , ssyCapabilities = Nothing - , ssyTags = Nothing - } - - scope = AwsScope - { awsAccountId = AccountId "1234567890" - , awsAccountName = "test-account" - , awsRegion = Region' "us-east-1" - } + specBody = + StackSpecYaml + { ssyDescription = Nothing + , ssyDepends = Nothing + , ssyActions = Nothing + , ssyTemplate = fromMaybe path mTemplate + , ssyParameters = Nothing + , ssyCapabilities = Nothing + , ssyTags = Nothing + } + + scope = + AwsScope + { awsAccountId = AccountId "1234567890" + , awsAccountName = "test-account" + , awsRegion = Region' "us-east-1" + } specName :: StackSpec -> Text specName = unStackName . stackSpecStackName diff --git a/test/Stackctl/StackDescriptionSpec.hs b/test/Stackctl/StackDescriptionSpec.hs index fa6d383..6f99346 100644 --- a/test/Stackctl/StackDescriptionSpec.hs +++ b/test/Stackctl/StackDescriptionSpec.hs @@ -26,8 +26,8 @@ spec = do it "does not clobber or duplicate an existing Description" $ do addStackDescription - aDescription - "Resources: []\nDescription: Existing description\n" + aDescription + "Resources: []\nDescription: Existing description\n" `shouldBe` "Resources: []\nDescription: Existing description\n" context "JSON" $ do @@ -37,6 +37,6 @@ spec = do it "does not clobber or duplicate an existing Description" $ do addStackDescription - aDescription - "{\"Resources\":[],\"Description\":\"Existing description\"}" + aDescription + "{\"Resources\":[],\"Description\":\"Existing description\"}" `shouldBe` "{\"Resources\":[],\"Description\":\"Existing description\"}" diff --git a/test/Stackctl/StackSpecSpec.hs b/test/Stackctl/StackSpecSpec.hs index a16b3cb..30105d5 100644 --- a/test/Stackctl/StackSpecSpec.hs +++ b/test/Stackctl/StackSpecSpec.hs @@ -16,38 +16,40 @@ 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" [] - ] + 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 = flip runReader emptyConfig - $ buildStackSpec "." specPath specBody +toSpec name depends = + flip runReader emptyConfig + $ buildStackSpec "." specPath specBody where stackName = StackName name specPath = stackSpecPath scope stackName "a/b.yaml" - specBody = StackSpecYaml - { ssyDescription = Nothing - , ssyDepends = Just $ map StackName depends - , ssyActions = Nothing - , ssyTemplate = "" - , ssyParameters = Nothing - , ssyCapabilities = Nothing - , ssyTags = Nothing - } + specBody = + StackSpecYaml + { ssyDescription = Nothing + , ssyDepends = Just $ map StackName depends + , ssyActions = Nothing + , ssyTemplate = "" + , ssyParameters = Nothing + , ssyCapabilities = Nothing + , ssyTags = Nothing + } - scope = AwsScope - { awsAccountId = AccountId "" - , awsAccountName = "" - , awsRegion = Region' "" - } + scope = + AwsScope + { awsAccountId = AccountId "" + , awsAccountName = "" + , awsRegion = Region' "" + } specName :: StackSpec -> Text specName = unStackName . stackSpecStackName diff --git a/test/Stackctl/StackSpecYamlSpec.hs b/test/Stackctl/StackSpecYamlSpec.hs index 53a4e7b..91942dc 100644 --- a/test/Stackctl/StackSpecYamlSpec.hs +++ b/test/Stackctl/StackSpecYamlSpec.hs @@ -8,8 +8,8 @@ import Stackctl.Prelude import Data.Aeson import qualified Data.Yaml as Yaml -import Stackctl.Action import Stackctl.AWS +import Stackctl.Action import Stackctl.StackSpecYaml import Test.Hspec @@ -17,123 +17,135 @@ spec :: Spec spec = do describe "From/ToJSON" $ do it "round trips" $ do - let - yaml = StackSpecYaml - { ssyDescription = Just $ StackDescription "Testing Stack" - , ssyTemplate = "path/to/template.yaml" - , ssyDepends = Just [StackName "a-stack", StackName "another-stack"] - , ssyActions = Just - [newAction PostDeploy $ InvokeLambdaByName "a-lambda"] - , ssyParameters = Just $ parametersYaml $ mapMaybe - parameterYaml - [makeParameter "PKey" $ Just "PValue"] - , ssyCapabilities = Just [Capability_CAPABILITY_IAM] - , ssyTags = Just $ tagsYaml [TagYaml $ newTag "TKey" "TValue"] - } + let yaml = + StackSpecYaml + { ssyDescription = Just $ StackDescription "Testing Stack" + , ssyTemplate = "path/to/template.yaml" + , ssyDepends = Just [StackName "a-stack", StackName "another-stack"] + , ssyActions = + Just + [newAction PostDeploy $ InvokeLambdaByName "a-lambda"] + , ssyParameters = + Just + $ parametersYaml + $ mapMaybe + parameterYaml + [makeParameter "PKey" $ Just "PValue"] + , ssyCapabilities = Just [Capability_CAPABILITY_IAM] + , ssyTags = Just $ tagsYaml [TagYaml $ newTag "TKey" "TValue"] + } eitherDecode (encode yaml) `shouldBe` Right yaml 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 [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + [ "Template: foo.yaml\n" + , "Parameters:\n" + , " - ParameterKey: Foo\n" + , " ParameterValue: Bar\n" + ] + + let Just [param] = map unParameterYaml . unParametersYaml <$> 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 [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + [ "Template: foo.yaml\n" + , "Parameters:\n" + , " - ParameterKey: Port\n" + , " ParameterValue: 80\n" + ] + + let Just [param] = map unParameterYaml . unParametersYaml <$> 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 [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + [ "Template: foo.yaml\n" + , "Parameters:\n" + , " - ParameterKey: Pie\n" + , " ParameterValue: 3.14\n" + ] + + let Just [param] = map unParameterYaml . unParametersYaml <$> 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" - ] + 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 "has informative errors in Object form" $ do - let - Left ex = Yaml.decodeEither' @StackSpecYaml $ mconcat - ["Template: foo.yaml\n", "Parameters:\n", " Norway: no\n"] + let Left ex = + Yaml.decodeEither' @StackSpecYaml + $ mconcat + ["Template: foo.yaml\n", "Parameters:\n", " Norway: no\n"] show ex `shouldBe` "AesonException \"Error in $.Parameters.Norway: Expected String or Number, got: Bool False\"" it "handles null Value" $ do - StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat - [ "Template: foo.yaml\n" - , "Parameters:\n" - , " - ParameterKey: Foo\n" - , " ParameterValue: null\n" - ] - - let - Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + [ "Template: foo.yaml\n" + , "Parameters:\n" + , " - ParameterKey: Foo\n" + , " ParameterValue: null\n" + ] + + let Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters param ^. parameter_parameterKey `shouldBe` Just "Foo" param ^. parameter_parameterValue `shouldBe` Nothing it "handles missing Value" $ do - StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat - ["Template: foo.yaml\n", "Parameters:\n", " - ParameterKey: Foo\n"] + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + ["Template: foo.yaml\n", "Parameters:\n", " - ParameterKey: Foo\n"] - let - Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + let Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters param ^. parameter_parameterKey `shouldBe` Just "Foo" param ^. parameter_parameterValue `shouldBe` Nothing 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 [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat + [ "Template: foo.yaml\n" + , "Parameters:\n" + , " - Name: Foo\n" + , " Value: Bar\n" + ] + + let Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters param ^. parameter_parameterKey `shouldBe` Just "Foo" param ^. parameter_parameterValue `shouldBe` Just "Bar" it "also accepts objects" $ do - StackSpecYaml {..} <- Yaml.decodeThrow - $ mconcat ["Template: foo.yaml\n", "Parameters:\n", " Foo: Bar\n"] + StackSpecYaml {..} <- + Yaml.decodeThrow + $ mconcat ["Template: foo.yaml\n", "Parameters:\n", " Foo: Bar\n"] - let - Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters + let Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters param ^. parameter_parameterKey `shouldBe` Just "Foo" param ^. parameter_parameterValue `shouldBe` Just "Bar" @@ -141,18 +153,20 @@ spec = do it "has overriding Semigroup semantics" $ do let a = parametersYaml [] - b = parametersYaml - $ catMaybes [parameterYaml $ makeParameter "Key" (Just "B")] - c = parametersYaml - $ catMaybes [parameterYaml $ makeParameter "Key" (Just "C")] - d = parametersYaml - $ catMaybes [parameterYaml $ makeParameter "Key" Nothing] + b = + parametersYaml + $ catMaybes [parameterYaml $ makeParameter "Key" (Just "B")] + c = + parametersYaml + $ catMaybes [parameterYaml $ makeParameter "Key" (Just "C")] + d = + parametersYaml + $ catMaybes [parameterYaml $ makeParameter "Key" Nothing] a <> b `shouldBe` b -- keeps keys in B b <> c `shouldBe` c -- C overrides B (Last) c <> d `shouldBe` c -- C overrides D (Just) d <> c `shouldBe` c -- C overrides D (Just) - describe "TagsYaml" $ do it "has overriding Semigroup semantics" $ do let From 45e41a6c8feebf4e51dd4ac899d85624917f5370 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Fri, 30 Jun 2023 09:05:36 -0400 Subject: [PATCH 4/8] Handle AWS ServiceError to more readable exit Any un-handled AWS errors would crash with a shown exception that is difficult to read. This handler just reformats it to a more readable error-log before still exiting failure. We implemented this in a downstream user of the library, but it makes sense to be in use all the time and provided by us. --- src/Stackctl/AWS/Core.hs | 21 +++++++++++++++++++++ src/Stackctl/Subcommand.hs | 6 +++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/Stackctl/AWS/Core.hs b/src/Stackctl/AWS/Core.hs index 21f2f2b..d413293 100644 --- a/src/Stackctl/AWS/Core.hs +++ b/src/Stackctl/AWS/Core.hs @@ -15,6 +15,9 @@ module Stackctl.AWS.Core -- * 'Amazonka' extensions , AccountId (..) + -- * Error-handling + , handlingServiceError + -- * 'Amazonka'/'ResourceT' re-exports , Region (..) , FromText (..) @@ -143,3 +146,21 @@ newtype AccountId = AccountId { unAccountId :: Text } deriving newtype (Eq, Ord, Show, ToJSON) + +-- | Handle 'ServiceError', log it and 'exitFailure' +-- +-- This is useful at the top-level of the app, where we'd be crashing anyway. It +-- makes things more readable and easier to debug. +handlingServiceError :: (MonadUnliftIO m, MonadLogger m) => m a -> m a +handlingServiceError = + handleJust @_ @SomeException (^? _ServiceError) $ \e -> do + logError + $ "Exiting due to AWS Service error" + :# [ "code" .= fromErrorCode (e ^. serviceCode) + , "message" .= fmap fromErrorMessage (e ^. serviceMessage) + , "requestId" .= fmap fromRequestId (e ^. serviceRequestId) + ] + exitFailure + +fromErrorCode :: ErrorCode -> Text +fromErrorCode (ErrorCode x) = x diff --git a/src/Stackctl/Subcommand.hs b/src/Stackctl/Subcommand.hs index 83f49fc..eb84864 100644 --- a/src/Stackctl/Subcommand.hs +++ b/src/Stackctl/Subcommand.hs @@ -10,6 +10,7 @@ import Stackctl.Prelude import qualified Env import Options.Applicative +import Stackctl.AWS (handlingServiceError) import Stackctl.AutoSSO import Stackctl.CLI import Stackctl.ColorOption @@ -71,7 +72,10 @@ runAppSubcommand -> subOptions -> options -> IO a -runAppSubcommand f subOptions options = runAppT options $ f subOptions +runAppSubcommand f subOptions options = + runAppT options + $ handlingServiceError + $ f subOptions withInfo :: Text -> Parser a -> ParserInfo a withInfo d p = info (p <**> helper) $ progDesc (unpack d) <> fullDesc From 6afb63a26fc1eb249055a3df7f8cd7ee2ac166af Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Fri, 30 Jun 2023 13:49:27 -0400 Subject: [PATCH 5/8] Handle removals before deploys It can be useful to deploy a single change set that deletes a stack using some name, then deploys a new one that uses that name. This doesn't work when we handle deletes after deploys. Reversing it handles that use-case better, without any downsides. --- src/Stackctl/Spec/Deploy.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Stackctl/Spec/Deploy.hs b/src/Stackctl/Spec/Deploy.hs index f3518d6..a9d6c2e 100644 --- a/src/Stackctl/Spec/Deploy.hs +++ b/src/Stackctl/Spec/Deploy.hs @@ -84,6 +84,10 @@ runDeploy => DeployOptions -> m () runDeploy DeployOptions {..} = do + when sdoRemovals $ do + removed <- inferRemovedStacks + traverse_ (deleteRemovedStack sdoDeployConfirmation) removed + specs <- discoverSpecs for_ specs $ \spec -> do @@ -111,10 +115,6 @@ runDeploy DeployOptions {..} = do runActions stackName PostDeploy $ stackSpecActions spec when sdoClean $ awsCloudFormationDeleteAllChangeSets stackName - when sdoRemovals $ do - removed <- inferRemovedStacks - traverse_ (deleteRemovedStack sdoDeployConfirmation) removed - deleteRemovedStack :: ( MonadMask m , MonadResource m From 9afbdfc834309a1726a823fb95ef9902ec626a08 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Wed, 14 Jun 2023 09:16:27 -0400 Subject: [PATCH 6/8] Use Blammo.Logging.Colors --- package.yaml | 2 +- src/Stackctl/Colors.hs | 28 +--------------------------- stack.yaml | 2 +- stack.yaml.lock | 8 ++++---- stackctl.cabal | 2 +- 5 files changed, 8 insertions(+), 34 deletions(-) diff --git a/package.yaml b/package.yaml index b6c07e0..c5bd951 100644 --- a/package.yaml +++ b/package.yaml @@ -58,7 +58,7 @@ default-extensions: library: source-dirs: src dependencies: - - Blammo >= 1.1.1.1 # pushLoggerLn, getLoggerShouldColor + - Blammo >= 1.1.2.1 # getColorsLogger, etc - Glob - QuickCheck - aeson diff --git a/src/Stackctl/Colors.hs b/src/Stackctl/Colors.hs index b7283d2..d51d781 100644 --- a/src/Stackctl/Colors.hs +++ b/src/Stackctl/Colors.hs @@ -1,31 +1,5 @@ --- | Facilities for colorizing output module Stackctl.Colors - ( Colors (..) - , getColorsStdout - , getColorsLogger - , noColors + ( module Blammo.Logging.Colors ) where -import Stackctl.Prelude - import Blammo.Logging.Colors -import Blammo.Logging.LogSettings (shouldColorHandle) -import Blammo.Logging.Logger - --- | Return 'Colors' based on options and 'stdout' -getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors -getColorsStdout = getColorsHandle stdout - --- | Return 'Colors' based on options given 'Handle' -getColorsHandle - :: (MonadIO m, MonadReader env m, HasLogger env) => Handle -> m Colors -getColorsHandle h = do - ls <- view $ loggerL . to getLoggerLogSettings - getColors <$> shouldColorHandle ls h - --- | Return 'Colors' consistent with the ambient 'Logger' -getColorsLogger :: (MonadReader env m, HasLogger env) => m Colors -getColorsLogger = view $ loggerL . to (getColors . getLoggerShouldColor) - -noColors :: Colors -noColors = getColors False diff --git a/stack.yaml b/stack.yaml index f5cf943..002dc35 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ resolver: lts-20.4 extra-deps: - - Blammo-1.1.1.1 + - Blammo-1.1.2.1 - cfn-flip-0.1.0.3 - unliftio-0.2.25.0 diff --git a/stack.yaml.lock b/stack.yaml.lock index 5b3ab93..c5f0be2 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,12 +5,12 @@ packages: - completed: - hackage: Blammo-1.1.1.1@sha256:2a40212b058e49f0449cd81a786a216a97ec1e4139870e571560312b50532430,4045 + hackage: Blammo-1.1.2.1@sha256:b74d553fb3557bb10381b806bd34b8bad0b800883f02dfd1cc847f58db40958c,4084 pantry-tree: - sha256: 2dc64fe1800fbb344ae8345762dc814e6014147671fe0749581b2fe1c6ed9a92 - size: 1490 + sha256: bd28931f07beaaae8565a87d8c3b55d3e9ff5c332ae93dc32c1090a4c814e620 + size: 1567 original: - hackage: Blammo-1.1.1.1 + hackage: Blammo-1.1.2.1 - completed: hackage: cfn-flip-0.1.0.3@sha256:8737882d818d74b29d3b1791a4df4dc89995870312374989c47c29352ea503ec,5615 pantry-tree: diff --git a/stackctl.cabal b/stackctl.cabal index 7e4b7b8..b3e6bed 100644 --- a/stackctl.cabal +++ b/stackctl.cabal @@ -97,7 +97,7 @@ library TypeFamilies ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-missing-kind-signatures -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.1.1 + Blammo >=1.1.2.1 , Glob , QuickCheck , aeson From e35504e3833667500b69495442e8b9a19d24a814 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 28 Aug 2023 13:11:38 -0400 Subject: [PATCH 7/8] Amazonka 2.0 --- package.yaml | 14 +-- src/Stackctl/AWS/CloudFormation.hs | 9 -- src/Stackctl/AWS/Core.hs | 90 ++++++++++++------- src/Stackctl/AutoSSO.hs | 7 +- stack.yaml | 24 +++--- stack.yaml.lock | 133 ++++++++++------------------- stackctl.cabal | 14 +-- 7 files changed, 133 insertions(+), 158 deletions(-) diff --git a/package.yaml b/package.yaml index c5bd951..546067e 100644 --- a/package.yaml +++ b/package.yaml @@ -64,13 +64,13 @@ library: - aeson - aeson-casing - aeson-pretty - - amazonka - - amazonka-cloudformation - - amazonka-core - - amazonka-ec2 - - amazonka-lambda - - amazonka-sso - - amazonka-sts + - amazonka >= 2.0 + - amazonka-cloudformation >= 2.0 + - amazonka-core >= 2.0 + - amazonka-ec2 >= 2.0 + - amazonka-lambda >= 2.0 + - amazonka-sso >= 2.0 + - amazonka-sts >= 2.0 - bytestring - cfn-flip >= 0.1.0.3 # bugfix for Condition - conduit diff --git a/src/Stackctl/AWS/CloudFormation.hs b/src/Stackctl/AWS/CloudFormation.hs index 8a24f5e..283f189 100644 --- a/src/Stackctl/AWS/CloudFormation.hs +++ b/src/Stackctl/AWS/CloudFormation.hs @@ -81,8 +81,6 @@ import Amazonka.Core ( AsError , ServiceError , hasStatus - , serviceCode - , serviceMessage , _MatchServiceError , _ServiceError ) @@ -503,10 +501,3 @@ runningStatuses = _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 - ] diff --git a/src/Stackctl/AWS/Core.hs b/src/Stackctl/AWS/Core.hs index d413293..28e1a01 100644 --- a/src/Stackctl/AWS/Core.hs +++ b/src/Stackctl/AWS/Core.hs @@ -17,6 +17,7 @@ module Stackctl.AWS.Core -- * Error-handling , handlingServiceError + , formatServiceError -- * 'Amazonka'/'ResourceT' re-exports , Region (..) @@ -30,6 +31,8 @@ import Stackctl.Prelude hiding (timeout) import Amazonka hiding (LogLevel (..)) import qualified Amazonka as AWS import Amazonka.Auth.Keys (fromSession) +import Amazonka.Data.Text (FromText (..), ToText (..)) +import Amazonka.Env (env_logger, env_region) import Amazonka.STS.AssumeRole import Conduit (ConduitM) import Control.Monad.Logger (defaultLoc, toLogStr) @@ -51,20 +54,19 @@ awsEnvDiscover = do 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) - } + + let logger level = 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 + pure $ env & env_logger .~ logger class HasAwsEnv env where awsEnvL :: Lens' env AwsEnv @@ -73,7 +75,13 @@ instance HasAwsEnv AwsEnv where awsEnvL = id awsSimple - :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a) + :: ( MonadResource m + , MonadReader env m + , HasAwsEnv env + , AWSRequest a + , Typeable a + , Typeable (AWSResponse a) + ) => Text -> a -> (AWSResponse a -> Maybe b) @@ -85,7 +93,13 @@ awsSimple name req post = do err = unpack name <> " successful, but processing the response failed" awsSend - :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a) + :: ( MonadResource m + , MonadReader env m + , HasAwsEnv env + , AWSRequest a + , Typeable a + , Typeable (AWSResponse a) + ) => a -> m (AWSResponse a) awsSend req = do @@ -93,7 +107,13 @@ awsSend req = do send env req awsPaginate - :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a) + :: ( MonadResource m + , MonadReader env m + , HasAwsEnv env + , AWSPager a + , Typeable a + , Typeable (AWSResponse a) + ) => a -> ConduitM () (AWSResponse a) m () awsPaginate req = do @@ -104,7 +124,12 @@ hoistEither :: MonadIO m => Either Error a -> m a hoistEither = either (liftIO . throwIO) pure awsAwait - :: (MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a) + :: ( MonadResource m + , MonadReader env m + , HasAwsEnv env + , AWSRequest a + , Typeable a + ) => Wait a -> a -> m Accept @@ -125,22 +150,22 @@ awsAssumeRole role sessionName f = do let req = newAssumeRole role sessionName assumeEnv <- awsSimple "sts:AssumeRole" req $ \resp -> do - creds <- resp ^. assumeRoleResponse_credentials - token <- creds ^. authSessionToken + let creds = resp ^. assumeRoleResponse_credentials + token <- creds ^. authEnv_sessionToken let - accessKeyId = creds ^. authAccessKeyId - secretAccessKey = creds ^. authSecretAccessKey + accessKeyId = creds ^. authEnv_accessKeyId + secretAccessKey = creds ^. authEnv_secretAccessKey . _Sensitive - pure $ fromSession accessKeyId secretAccessKey token + pure $ fromSession accessKeyId secretAccessKey $ token ^. _Sensitive local (awsEnvL . unL %~ assumeEnv) f awsWithin :: (MonadReader env m, HasAwsEnv env) => Region -> m a -> m a -awsWithin r = local $ over (awsEnvL . unL) (within r) +awsWithin r = local $ awsEnvL . unL . env_region .~ r awsTimeout :: (MonadReader env m, HasAwsEnv env) => Seconds -> m a -> m a -awsTimeout t = local $ over (awsEnvL . unL) (timeout t) +awsTimeout t = local $ over (awsEnvL . unL) (globalTimeout t) newtype AccountId = AccountId { unAccountId :: Text @@ -156,11 +181,16 @@ handlingServiceError = handleJust @_ @SomeException (^? _ServiceError) $ \e -> do logError $ "Exiting due to AWS Service error" - :# [ "code" .= fromErrorCode (e ^. serviceCode) - , "message" .= fmap fromErrorMessage (e ^. serviceMessage) - , "requestId" .= fmap fromRequestId (e ^. serviceRequestId) + :# [ "code" .= toText (e ^. serviceError_code) + , "message" .= fmap toText (e ^. serviceError_message) + , "requestId" .= fmap toText (e ^. serviceError_requestId) ] exitFailure -fromErrorCode :: ErrorCode -> Text -fromErrorCode (ErrorCode x) = x +formatServiceError :: ServiceError -> Text +formatServiceError e = + mconcat + [ toText $ e ^. serviceError_code + , maybe "" ((": " <>) . toText) $ e ^. serviceError_message + , maybe "" (("\nRequest Id: " <>) . toText) $ e ^. serviceError_requestId + ] diff --git a/src/Stackctl/AutoSSO.hs b/src/Stackctl/AutoSSO.hs index 3a791f8..cf20e3a 100644 --- a/src/Stackctl/AutoSSO.hs +++ b/src/Stackctl/AutoSSO.hs @@ -10,12 +10,13 @@ module Stackctl.AutoSSO import Stackctl.Prelude import Amazonka.SSO (_UnauthorizedException) -import Amazonka.Types (Error, ErrorMessage (..), serviceMessage) import Data.Semigroup (Last (..)) import qualified Env import Options.Applicative +import Stackctl.AWS.Core (formatServiceError) import Stackctl.Prompt import System.Process.Typed +import UnliftIO.Exception.Lens (catching) data AutoSSOOption = AutoSSOAlways @@ -61,7 +62,7 @@ handleAutoSSO -> m a -> m a handleAutoSSO options f = do - catchJust (preview (_UnauthorizedException @Error)) f $ \ex -> do + catching _UnauthorizedException f $ \ex -> do case options ^. autoSSOOptionL of AutoSSOAlways -> do logWarn $ ssoErrorMessage ex @@ -78,6 +79,6 @@ handleAutoSSO options f = do where ssoErrorMessage ex = "AWS SSO authorization error" - :# [ "message" .= fmap fromErrorMessage (ex ^. serviceMessage) + :# [ "message" .= formatServiceError ex , "hint" .= ("Run `aws sso login' and try again" :: Text) ] diff --git a/stack.yaml b/stack.yaml index 002dc35..3a4757c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,15 +5,15 @@ extra-deps: - cfn-flip-0.1.0.3 - unliftio-0.2.25.0 - - github: brendanhay/amazonka - commit: f73a957d05f64863e867cf39d0db260718f0fadd # main, as of SSO support - subdirs: - - lib/amazonka - - lib/amazonka-core - - lib/services/amazonka-certificatemanager - - lib/services/amazonka-cloudformation - - lib/services/amazonka-ec2 - - lib/services/amazonka-ecr - - lib/services/amazonka-lambda - - lib/services/amazonka-sso - - lib/services/amazonka-sts + - amazonka-2.0 + - amazonka-core-2.0 + - amazonka-certificatemanager-2.0 + - amazonka-cloudformation-2.0 + - amazonka-ec2-2.0 + - amazonka-ecr-2.0 + - amazonka-lambda-2.0 + - amazonka-sso-2.0 + - amazonka-sts-2.0 + + # For amazonka-core-2.0 + - crypton-0.33 diff --git a/stack.yaml.lock b/stack.yaml.lock index c5f0be2..7659034 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -26,122 +26,75 @@ packages: original: hackage: unliftio-0.2.25.0 - completed: - name: amazonka + hackage: amazonka-2.0@sha256:3481da2fda6b210d15d41c1db7a588adf68123cfb7ea3882797a6230003259db,3505 pantry-tree: - sha256: 0257a27c3332e400abc0f4a38f7a875c4a2a04b03ac342d7481e19d9d5665040 - size: 1257 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/amazonka - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: 01c7121bd5e4a3918a71ea6502412292c97facf20c9620f07af96e423d6437e2 + size: 1528 original: - subdir: lib/amazonka - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-2.0 - completed: - name: amazonka-core + hackage: amazonka-core-2.0@sha256:d9f0533c272ac92bd7b18699077038b6b51b3552e91b65743af4ce646286b4f8,4383 pantry-tree: - sha256: 2eadbad33f65f20781409c4de9faee04e7e4baa92906db696b78689f53de0a83 - size: 3117 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/amazonka-core - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: 46e7e4de910b08ee2df98db9cda2becf388ce49510024018289a46c43e175ee0 + size: 3222 original: - subdir: lib/amazonka-core - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-core-2.0 - completed: - name: amazonka-certificatemanager + hackage: amazonka-certificatemanager-2.0@sha256:9a203a46ec1eaae2c59aa891efa480f84411783d02ba973820d67e95cc67756c,5226 pantry-tree: - sha256: 86c39ebac8e40030c05048385c1153deb124193e49bb2651c38bd1232bbd3fff - size: 7063 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-certificatemanager - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: 9ee7f26c6166f2b01f32efcf41d4a6315ff681823c698f49036f5b471ffb6e9c + size: 7191 original: - subdir: lib/services/amazonka-certificatemanager - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-certificatemanager-2.0 - completed: - name: amazonka-cloudformation + hackage: amazonka-cloudformation-2.0@sha256:7a9618bf697cdaf0a51c2d7be557ad47820b926416d79f5138ff3befdbfcbafb,11870 pantry-tree: - sha256: a9f557fdf3f3d5f960a28921465609e338ce702e1ecdf6e559e01efdccb364a6 - size: 25784 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-cloudformation - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: 177fbc16ea2fa072a7fca9f4a3b1d64f4d5e8fc7cd493e4e841f337c572745bd + size: 27257 original: - subdir: lib/services/amazonka-cloudformation - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-cloudformation-2.0 - completed: - name: amazonka-ec2 + hackage: amazonka-ec2-2.0@sha256:9344b87d8f8328fd91023b96565e79e7676aa5e7dd40b87b3f3f3a22a9da7736,74154 pantry-tree: - sha256: 29c4666aa6cd81a371cdef208199f45a99d9fdef31f3ff9450c1762a64dd60d0 - size: 190150 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-ec2 - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: d1f2d4fce5b0664605d730d4232b25f26a5f49e3b7d07f4b282e8c36773e5ffd + size: 234434 original: - subdir: lib/services/amazonka-ec2 - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-ec2-2.0 - completed: - name: amazonka-ecr + hackage: amazonka-ecr-2.0@sha256:88ec5dffb3c07f9e49eb4d9672ac62c175b6cf2c3e044ec0e4c705cd6bff3487,6925 pantry-tree: - sha256: 8c8b2a242ac973b0205916de20d8066cf3820acd47d98d6ec6df9182f6b31966 - size: 12161 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-ecr - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: d0d5dc0ed4aab28f0d6183657e77985693c5ed011dd0cc40d335b6a334b1939a + size: 15627 original: - subdir: lib/services/amazonka-ecr - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-ecr-2.0 - completed: - name: amazonka-lambda + hackage: amazonka-lambda-2.0@sha256:aa74299380318b04429980eb76b7f0499a8241ff01de859042b0ff09bd7ef420,8281 pantry-tree: - sha256: 7e6feb0f8af0a9f6ce20db04d69a0e7b92838f27d17f65f0cd1a3c87b6a6331e - size: 19117 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-lambda - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: da8f346de9d1eb0fb12afa91e44f8179ac05176043919346e2e72a7880b7a9e5 + size: 21343 original: - subdir: lib/services/amazonka-lambda - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-lambda-2.0 - completed: - name: amazonka-sso + hackage: amazonka-sso-2.0@sha256:902be13b604e4a3b51a9b8e1adc6a32f42322ae11f738a72a8c737b2d0a91a5e,2995 pantry-tree: - sha256: f11babeeaf0481ae68134ced86e9d1d9396d1beb7bd70e0a1e6b77bc4148a192 - size: 1869 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-sso - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: f87dd959a78bf54295bd6f8c7da58f7f8f860251d5548ecb05ab758e03cba50b + size: 1817 original: - subdir: lib/services/amazonka-sso - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-sso-2.0 - completed: - name: amazonka-sts + hackage: amazonka-sts-2.0@sha256:5c721083e8d80883a893176de6105c27bbbd8176f467c27ac5f8d548a5e726d8,3209 pantry-tree: - sha256: 64ed22eaaea868b32cf56f162d1bd7332b048d8f2ea073c4e9827ed08e71cc70 - size: 2932 - sha256: 14aeaa9f748f7ac03683e8a8126760ed16aa82152404a96c0333b582444cd381 - size: 27775608 - subdir: lib/services/amazonka-sts - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz - version: '2.0' + sha256: bde4691af7cac74e0a3705271b4d3ac05515863bfb6f668112e3f3950a27cb41 + size: 2880 original: - subdir: lib/services/amazonka-sts - url: https://github.com/brendanhay/amazonka/archive/f73a957d05f64863e867cf39d0db260718f0fadd.tar.gz + hackage: amazonka-sts-2.0 +- completed: + hackage: crypton-0.33@sha256:5e92f29b9b7104d91fcdda1dec9400c9ad1f1791c231cc41ceebd783fb517dee,18202 + pantry-tree: + sha256: 38809499d7f9775ef45cd29ab5c3dc9b283a813f34c1cdc56681b24f8cf8bb4f + size: 23148 + original: + hackage: crypton-0.33 snapshots: - completed: sha256: 3770dfd79f5aed67acdcc65c4e7730adddffe6dba79ea723cfb0918356fc0f94 diff --git a/stackctl.cabal b/stackctl.cabal index b3e6bed..4acd86e 100644 --- a/stackctl.cabal +++ b/stackctl.cabal @@ -103,13 +103,13 @@ library , aeson , aeson-casing , aeson-pretty - , amazonka - , amazonka-cloudformation - , amazonka-core - , amazonka-ec2 - , amazonka-lambda - , amazonka-sso - , amazonka-sts + , amazonka >=2.0 + , amazonka-cloudformation >=2.0 + , amazonka-core >=2.0 + , amazonka-ec2 >=2.0 + , amazonka-lambda >=2.0 + , amazonka-sso >=2.0 + , amazonka-sts >=2.0 , base ==4.* , bytestring , cfn-flip >=0.1.0.3 From defc1b7de5ace2bde187eac6b637d5670f9ab2c7 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 28 Aug 2023 13:13:37 -0400 Subject: [PATCH 8/8] Version bump --- CHANGELOG.md | 8 +++++++- package.yaml | 2 +- stackctl.cabal | 2 +- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 681e8b1..5caa541 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,10 @@ -## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.4.2.1...main) +## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.4.2.2...main) + +## [v1.4.2.2](https://github.com/freckle/stackctl/compare/v1.4.2.1...v1.4.2.2) + +- Use `amazonka-2.0` :tada: +- Finalize update to `UnliftIO.Exception.Lens` +- Re-export upstreamed `Blammo.Logging.Colors` ## [v1.4.2.1](https://github.com/freckle/stackctl/compare/v1.4.2.0...v1.4.2.1) diff --git a/package.yaml b/package.yaml index 546067e..2a4d096 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: stackctl -version: 1.4.2.1 +version: 1.4.2.2 github: freckle/stackctl license: MIT author: Freckle Engineering diff --git a/stackctl.cabal b/stackctl.cabal index 4acd86e..ae1dcb6 100644 --- a/stackctl.cabal +++ b/stackctl.cabal @@ -5,7 +5,7 @@ cabal-version: 1.18 -- see: https://github.com/sol/hpack name: stackctl -version: 1.4.2.1 +version: 1.4.2.2 description: Please see homepage: https://github.com/freckle/stackctl#readme bug-reports: https://github.com/freckle/stackctl/issues