stackctl 1.4.0.1 → 1.4.2.0
raw patch · 12 files changed
+214/−16 lines, 12 filesdep +amazonka-ssodep +typed-process
Dependencies added: amazonka-sso, typed-process
Files
- CHANGELOG.md +6/−1
- README.md +2/−2
- app/Main.hs +1/−0
- src/Stackctl/AutoSSO.hs +81/−0
- src/Stackctl/CLI.hs +6/−1
- src/Stackctl/Commands.hs +22/−5
- src/Stackctl/Options.hs +10/−0
- src/Stackctl/Prompt.hs +8/−1
- src/Stackctl/Spec/List.hs +62/−0
- src/Stackctl/StackSpec.hs +6/−4
- src/Stackctl/Subcommand.hs +5/−1
- stackctl.cabal +5/−1
CHANGELOG.md view
@@ -1,4 +1,9 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.4.0.1...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.4.2.0...main)++## [v1.4.2.0](https://github.com/freckle/stackctl/compare/v1.4.0.1...v1.4.2.0)++- Add `stackctl-ls` for listing stacks and their deployed status+- Add `--auto-sso` option for automating `aws sso login` when required ## [v1.4.0.1](https://github.com/freckle/stackctl/compare/v1.4.0.0...v1.4.0.1)
README.md view
@@ -72,8 +72,8 @@ - `man 1 stackctl`, or - `man 1 stackctl <command>` -The man pages are also available [in-repository](./doc), but contain-documentation as of `main`, and not your installed version.+The man pages are also available [online](https://freckle.github.io/stackctl/),+but contain documentation as of `main`, and not your installed version. ## Relationship to CloudGenesis
app/Main.hs view
@@ -14,4 +14,5 @@ <> subcommand Commands.capture <> subcommand Commands.changes <> subcommand Commands.deploy+ <> subcommand Commands.list <> subcommand Commands.version
+ src/Stackctl/AutoSSO.hs view
@@ -0,0 +1,81 @@+module Stackctl.AutoSSO+ ( AutoSSOOption+ , defaultAutoSSOOption+ , HasAutoSSOOption(..)+ , autoSSOOption+ , envAutoSSOOption+ , handleAutoSSO+ ) where++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.Prompt+import System.Process.Typed++data AutoSSOOption+ = AutoSSOAlways+ | AutoSSOAsk+ | AutoSSONever+ deriving Semigroup via Last AutoSSOOption++defaultAutoSSOOption :: AutoSSOOption+defaultAutoSSOOption = AutoSSOAsk++readAutoSSO :: String -> Either String AutoSSOOption+readAutoSSO = \case+ "always" -> Right AutoSSOAlways+ "ask" -> Right AutoSSOAsk+ "never" -> Right AutoSSONever+ x ->+ Left $ "Invalid choice for auto-sso: " <> x <> ", must be always|ask|never"++class HasAutoSSOOption env where+ autoSSOOptionL :: Lens' env AutoSSOOption++autoSSOOption :: Parser AutoSSOOption+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++autoSSOHelp :: IsString a => a+autoSSOHelp = "Automatically run aws-sso-login if necessary?"++handleAutoSSO+ :: ( MonadUnliftIO m+ , MonadReader env m+ , MonadLogger m+ , HasLogger env+ , HasAutoSSOOption options+ )+ => options+ -> m a+ -> m a+handleAutoSSO options f = do+ catchJust (preview (_UnauthorizedException @Error)) f $ \ex -> do+ case options ^. autoSSOOptionL of+ AutoSSOAlways -> do+ logWarn $ ssoErrorMessage ex+ logInfo "Running `aws sso login' automatically"+ AutoSSOAsk -> do+ logWarn $ ssoErrorMessage ex+ promptOrExit "Run `aws sso login'"+ AutoSSONever -> do+ logError $ ssoErrorMessage ex+ exitFailure++ runProcess_ $ proc "aws" ["sso", "login"]+ f+ where+ ssoErrorMessage ex =+ "AWS SSO authorization error"+ :# [ "message" .= fmap fromErrorMessage (ex ^. serviceMessage)+ , "hint" .= ("Run `aws sso login' and try again" :: Text)+ ]
src/Stackctl/CLI.hs view
@@ -10,6 +10,7 @@ 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.ColorOption@@ -53,6 +54,9 @@ instance HasVerboseOption options => HasVerboseOption (App options) where verboseOptionL = optionsL . verboseOptionL +instance HasAutoSSOOption options => HasAutoSSOOption (App options) where+ autoSSOOptionL = optionsL . autoSSOOptionL+ newtype AppT app m a = AppT { unAppT :: ReaderT app (LoggingT (ResourceT m)) a }@@ -75,6 +79,7 @@ , MonadUnliftIO m , HasColorOption options , HasVerboseOption options+ , HasAutoSSOOption options ) => options -> AppT (App options) m a@@ -92,7 +97,7 @@ envLogSettings app <- runResourceT $ runLoggerLoggingT logger $ do- aws <- awsEnvDiscover+ aws <- runReaderT (handleAutoSSO options awsEnvDiscover) logger App logger <$> loadConfigOrExit
src/Stackctl/Commands.hs view
@@ -1,13 +1,10 @@ module Stackctl.Commands- ( cat- , capture- , changes- , deploy- , version+ ( module Stackctl.Commands ) where import Stackctl.Prelude +import Stackctl.AutoSSO import Stackctl.ColorOption import Stackctl.DirectoryOption import Stackctl.FilterOption@@ -15,6 +12,7 @@ import Stackctl.Spec.Cat import Stackctl.Spec.Changes import Stackctl.Spec.Deploy+import Stackctl.Spec.List import Stackctl.Subcommand import Stackctl.VerboseOption import Stackctl.Version@@ -24,6 +22,7 @@ , HasVerboseOption options , HasDirectoryOption options , HasFilterOption options+ , HasAutoSSOOption options ) => Subcommand options CatOptions cat = Subcommand@@ -37,6 +36,7 @@ :: ( HasColorOption options , HasVerboseOption options , HasDirectoryOption options+ , HasAutoSSOOption options ) => Subcommand options CaptureOptions capture = Subcommand@@ -51,6 +51,7 @@ , HasVerboseOption options , HasDirectoryOption options , HasFilterOption options+ , HasAutoSSOOption options ) => Subcommand options ChangesOptions changes = Subcommand@@ -65,6 +66,7 @@ , HasVerboseOption options , HasDirectoryOption options , HasFilterOption options+ , HasAutoSSOOption options ) => Subcommand options DeployOptions deploy = Subcommand@@ -72,6 +74,21 @@ , description = "Deploy specifications" , parse = parseDeployOptions , run = runAppSubcommand runDeploy+ }++list+ :: ( HasColorOption options+ , HasVerboseOption options+ , HasDirectoryOption options+ , HasFilterOption options+ , HasAutoSSOOption options+ )+ => Subcommand options ListOptions+list = Subcommand+ { name = "ls"+ , description = "List specifications"+ , parse = parseListOptions+ , run = runAppSubcommand runList } version :: Subcommand options ()
src/Stackctl/Options.hs view
@@ -9,6 +9,7 @@ import Data.Semigroup.Generic import qualified Env import Options.Applicative+import Stackctl.AutoSSO import Stackctl.ColorOption import Stackctl.DirectoryOption import Stackctl.FilterOption@@ -19,6 +20,7 @@ , oFilter :: Maybe FilterOption , oColor :: Maybe ColorOption , oVerbose :: Verbosity+ , oAutoSSO :: Maybe AutoSSOOption } deriving stock Generic deriving Semigroup via GenericSemigroupMonoid Options@@ -29,6 +31,9 @@ filterL :: Lens' Options (Maybe FilterOption) filterL = lens oFilter $ \x y -> x { oFilter = y } +autoSSOL :: Lens' Options (Maybe AutoSSOOption)+autoSSOL = lens oAutoSSO $ \x y -> x { oAutoSSO = y }+ instance HasDirectoryOption Options where directoryOptionL = directoryL . maybeLens defaultDirectoryOption @@ -41,6 +46,9 @@ instance HasVerboseOption Options where verboseOptionL = lens oVerbose $ \x y -> x { oVerbose = y } +instance HasAutoSSOOption Options where+ autoSSOOptionL = autoSSOL . maybeLens defaultAutoSSOOption+ -- brittany-disable-next-binding envParser :: Env.Parser Env.Error Options@@ -49,6 +57,7 @@ <*> optional (envFilterOption "specifications") <*> pure mempty -- use LOG_COLOR <*> pure mempty -- use LOG_LEVEL+ <*> optional envAutoSSOOption -- brittany-disable-next-binding @@ -58,3 +67,4 @@ <*> optional (filterOption "specifications") <*> optional colorOption <*> verboseOption+ <*> optional autoSSOOption
src/Stackctl/Prompt.hs view
@@ -1,6 +1,7 @@ module Stackctl.Prompt ( prompt , promptContinue+ , promptOrExit ) where import Stackctl.Prelude@@ -34,7 +35,13 @@ promptContinue :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => m ()-promptContinue = prompt "Continue (y/n)" parse dispatch+promptContinue = promptOrExit "Continue"++promptOrExit+ :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env)+ => Text+ -> m ()+promptOrExit msg = prompt (msg <> " (y/n)") parse dispatch where parse x | x `elem` ["y", "Y"] = Right True
+ src/Stackctl/Spec/List.hs view
@@ -0,0 +1,62 @@+module Stackctl.Spec.List+ ( ListOptions(..)+ , parseListOptions+ , runList+ ) where++import Stackctl.Prelude++import Blammo.Logging.Logger (pushLoggerLn)+import Options.Applicative+import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Colors+import Stackctl.Config (HasConfig)+import Stackctl.DirectoryOption (HasDirectoryOption(..))+import Stackctl.FilterOption (HasFilterOption)+import Stackctl.Spec.Discover+import Stackctl.StackSpec++data ListOptions = ListOptions++-- brittany-disable-next-binding++parseListOptions :: Parser ListOptions+parseListOptions = pure ListOptions++runList+ :: ( MonadUnliftIO m+ , MonadMask m+ , MonadResource m+ , MonadLogger m+ , MonadReader env m+ , HasAwsScope env+ , HasAwsEnv env+ , HasLogger env+ , HasConfig env+ , HasDirectoryOption env+ , HasFilterOption env+ )+ => ListOptions+ -> m ()+runList _ = do+ specs <- discoverSpecs+ Colors {..} <- getColorsLogger++ for_ specs $ \spec -> do+ let+ path = stackSpecFilePath spec+ name = stackSpecStackName spec++ exists <- isJust <$> awsCloudFormationDescribeStackMaybe name++ let+ formatted :: Text+ formatted =+ " "+ <> (if exists then green "✓ " else yellow "✗ ")+ <> cyan (unStackName name)+ <> " => "+ <> magenta (pack path)++ pushLoggerLn formatted
src/Stackctl/StackSpec.hs view
@@ -1,5 +1,6 @@ module Stackctl.StackSpec ( StackSpec+ , stackSpecFilePath , stackSpecSpecPath , stackSpecSpecBody , stackSpecStackName@@ -45,6 +46,10 @@ stackSpecSpecRoot :: StackSpec -> FilePath stackSpecSpecRoot = ssSpecRoot +stackSpecFilePath :: StackSpec -> FilePath+stackSpecFilePath spec =+ FilePath.normalise $ stackSpecSpecRoot spec </> stackSpecStackFile spec+ stackSpecSpecPath :: StackSpec -> StackSpecPath stackSpecSpecPath = ssSpecPath @@ -160,10 +165,7 @@ liftIO $ Yaml.encodeFile specPath $ stackSpecSpecBody stackSpec where templatePath = unStackTemplate $ stackSpecTemplate stackSpec- specPath =- FilePath.normalise- $ stackSpecSpecRoot stackSpec- </> stackSpecStackFile stackSpec+ specPath = stackSpecFilePath stackSpec readStackSpec :: (MonadIO m, MonadReader env m, HasConfig env)
src/Stackctl/Subcommand.hs view
@@ -10,6 +10,7 @@ import qualified Env import Options.Applicative+import Stackctl.AutoSSO import Stackctl.CLI import Stackctl.ColorOption import Stackctl.Options@@ -61,7 +62,10 @@ -- @ -- runAppSubcommand- :: (HasColorOption options, HasVerboseOption options)+ :: ( HasColorOption options+ , HasVerboseOption options+ , HasAutoSSOOption options+ ) => (subOptions -> AppT (App options) IO a) -> subOptions -> options
stackctl.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: stackctl-version: 1.4.0.1+version: 1.4.2.0 license: MIT license-file: LICENSE copyright: 2022 Renaissance Learning Inc@@ -21,6 +21,7 @@ library exposed-modules: Stackctl.Action+ Stackctl.AutoSSO Stackctl.AWS Stackctl.AWS.CloudFormation Stackctl.AWS.Core@@ -50,6 +51,7 @@ Stackctl.Spec.Deploy Stackctl.Spec.Discover Stackctl.Spec.Generate+ Stackctl.Spec.List Stackctl.StackDescription Stackctl.StackSpec Stackctl.StackSpecPath@@ -91,6 +93,7 @@ amazonka-core, amazonka-ec2, amazonka-lambda,+ amazonka-sso, amazonka-sts, base >=4 && <5, bytestring,@@ -113,6 +116,7 @@ text, time, transformers,+ typed-process, unliftio, unliftio-core, unordered-containers,