stackctl 1.1.2.2 → 1.1.3.0

raw patch · 21 files changed

+805/−101 lines, 21 filesdep +QuickCheckdep +mtl

Dependencies added: QuickCheck, mtl

Files

• CHANGELOG.md +22/−1
• README.md +3/−0
• src/Stackctl/CLI.hs +12/−7
• src/Stackctl/Commands.hs +5/−1
• src/Stackctl/Config.hs +106/−0
• src/Stackctl/Config/RequiredVersion.hs +81/−0
• src/Stackctl/FilterOption.hs +37/−8
• src/Stackctl/Spec/Capture.hs +2/−0
• src/Stackctl/Spec/Cat.hs +32/−18
• src/Stackctl/Spec/Changes.hs +2/−0
• src/Stackctl/Spec/Deploy.hs +3/−1
• src/Stackctl/Spec/Discover.hs +14/−9
• src/Stackctl/Spec/Generate.hs +5/−3
• src/Stackctl/StackSpec.hs +35/−15
• src/Stackctl/StackSpecYaml.hs +108/−13
• stackctl.cabal +9/−1
• test/Stackctl/Config/RequiredVersionSpec.hs +80/−0
• test/Stackctl/ConfigSpec.hs +75/−0
• test/Stackctl/FilterOptionSpec.hs +98/−19
• test/Stackctl/StackSpecSpec.hs +3/−1
• test/Stackctl/StackSpecYamlSpec.hs +73/−4

@@ -1,4 +1,25 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.2.2...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.3.0...main)++## [v1.1.3.0](https://github.com/freckle/stackctl/compare/v1.1.2.2...v1.1.3.0)++- Repository-local configuration++  See https://github.com/freckle/stackctl/commit/564678203fe70b5c4c46c655dd3daeaafb6de9e0++- Don't duplicate re-used templates in `stackctl-cat`+- Improve `--filter`++  - Match against stack name and template, in addition to spec path.+  - Automatically prepend `**/` (unless there is already a leading wildcard) and+    append `{/*,.yaml,.json}` (unless there is already a trailing wildcard or+    extension).++  In general, this aims to make `--filter` match more things more intuitively+  for operators, but still match exactly in programmatic use-cases.++- Various documentation improvements+- Support more natural `{Key}: {Value}` syntax in `Parameters` and `Tags`+- Fix bug where we may generate an `{}` element in `Parameters`  ## [v1.1.2.2](https://github.com/freckle/stackctl/compare/v1.1.2.1...v1.1.2.2) 

@@ -1,5 +1,8 @@ # Stackctl +[![Hackage](https://img.shields.io/hackage/v/stackctl.svg?style=flat)](https://hackage.haskell.org/package/stackctl)+[![CI](https://github.com/freckle/stackctl/actions/workflows/ci.yml/badge.svg)](https://github.com/freckle/stackctl/actions/workflows/ci.yml)+ Manage CloudFormation Stacks through specifications.  ## About

@@ -13,12 +13,14 @@ import Stackctl.AWS import Stackctl.AWS.Scope import Stackctl.ColorOption+import Stackctl.Config import Stackctl.DirectoryOption import Stackctl.FilterOption import Stackctl.VerboseOption  data App options = App   { appLogger :: Logger+  , appConfig :: Config   , appOptions :: options   , appAwsScope :: AwsScope   , appAwsEnv :: AwsEnv@@ -30,6 +32,9 @@ instance HasLogger (App options) where   loggerL = lens appLogger $ \x y -> x { appLogger = y } +instance HasConfig (App options) where+  configL = lens appConfig $ \x y -> x { appConfig = y }+ instance HasAwsScope (App options) where   awsScopeL = lens appAwsScope $ \x y -> x { appAwsScope = y } @@ -86,14 +91,14 @@     (options ^. verboseOptionL)     envLogSettings -  aws <- runLoggerLoggingT logger awsEnvDiscover--  let-    runAws-      :: MonadUnliftIO m => ReaderT AwsEnv (LoggingT (ResourceT m)) a -> m a-    runAws = runResourceT . runLoggerLoggingT logger . flip runReaderT aws+  app <- runResourceT $ runLoggerLoggingT logger $ do+    aws <- awsEnvDiscover -  app <- App logger options <$> runAws fetchAwsScope <*> pure aws+    App logger+      <$> loadConfigOrExit+      <*> pure options+      <*> runReaderT fetchAwsScope aws+      <*> pure aws    let     AwsScope {..} = appAwsScope app

@@ -11,6 +11,7 @@ import Stackctl.AWS import Stackctl.AWS.Scope import Stackctl.Colors+import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption import Stackctl.FilterOption import Stackctl.Spec.Capture@@ -23,6 +24,7 @@ cat   :: ( HasLogger env      , HasAwsScope env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      , HasColorOption env@@ -36,7 +38,7 @@   }  capture-  :: (HasAwsScope env, HasAwsEnv env, HasDirectoryOption env)+  :: (HasAwsScope env, HasAwsEnv env, HasConfig env, HasDirectoryOption env)   => Subcommand CaptureOptions env capture = Subcommand   { name = "capture"@@ -49,6 +51,7 @@   :: ( HasLogger env      , HasAwsScope env      , HasAwsEnv env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      )@@ -64,6 +67,7 @@   :: ( HasLogger env      , HasAwsScope env      , HasAwsEnv env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      )

@@ -0,0 +1,106 @@+module Stackctl.Config+  ( Config(..)+  , configParameters+  , configTags+  , emptyConfig+  , HasConfig(..)+  , ConfigError(..)+  , loadConfigOrExit+  , loadConfigFromBytes+  , applyConfig+  ) where++import Stackctl.Prelude++import Control.Monad.Except+import Data.Aeson+import Data.Version+import qualified Data.Yaml as Yaml+import Paths_stackctl as Paths+import Stackctl.Config.RequiredVersion+import Stackctl.StackSpecYaml+import UnliftIO.Directory (doesFileExist)++data Config = Config+  { required_version :: Maybe RequiredVersion+  , defaults :: Maybe Defaults+  }+  deriving stock Generic+  deriving anyclass FromJSON++configParameters :: Config -> Maybe ParametersYaml+configParameters = parameters <=< defaults++configTags :: Config -> Maybe TagsYaml+configTags = tags <=< defaults++emptyConfig :: Config+emptyConfig = Config Nothing Nothing++data Defaults = Defaults+  { parameters :: Maybe ParametersYaml+  , tags :: Maybe TagsYaml+  }+  deriving stock Generic+  deriving anyclass FromJSON++class HasConfig env where+  configL :: Lens' env Config++instance HasConfig Config where+  configL = id++data ConfigError+  = ConfigInvalidYaml Yaml.ParseException+  | ConfigInvalid (NonEmpty Text)+  | ConfigVersionNotSatisfied RequiredVersion Version+  deriving stock Show++configErrorMessage :: ConfigError -> Message+configErrorMessage = \case+  ConfigInvalidYaml ex ->+    "Configuration is not valid Yaml"+      :# ["error" .= Yaml.prettyPrintParseException ex]+  ConfigInvalid errs -> "Invalid configuration" :# ["errors" .= errs]+  ConfigVersionNotSatisfied rv v ->+    "Incompatible Stackctl version" :# ["current" .= v, "required" .= show rv]++loadConfigOrExit :: (MonadIO m, MonadLogger m) => m Config+loadConfigOrExit = either die pure =<< loadConfig+ where+  die e = do+    logError $ configErrorMessage e+    exitFailure++loadConfig :: MonadIO m => m (Either ConfigError Config)+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)++loadConfigFromBytes :: MonadError ConfigError m => ByteString -> m Config+loadConfigFromBytes bs = do+  config <- either (throwError . ConfigInvalidYaml) pure $ Yaml.decodeEither' bs+  config <$ traverse_ checkRequiredVersion (required_version config)+ where+  checkRequiredVersion rv =+    unless (isRequiredVersionSatisfied rv Paths.version)+      $ throwError+      $ ConfigVersionNotSatisfied rv Paths.version++applyConfig :: Config -> StackSpecYaml -> StackSpecYaml+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"+  ]

@@ -0,0 +1,81 @@+module Stackctl.Config.RequiredVersion+  ( RequiredVersion(..)+  , requiredVersionFromText+  , isRequiredVersionSatisfied++  -- * Exported for testing+  , (=~)+  ) where++import Stackctl.Prelude++import Data.Aeson+import Data.List (uncons)+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Data.Version hiding (parseVersion)+import qualified Data.Version as Version+import Text.ParserCombinators.ReadP (readP_to_S)++data RequiredVersion = RequiredVersion+  { requiredVersionOp :: Text+  , requiredVersionCompare :: Version -> Version -> Bool+  , requiredVersionCompareWith :: Version+  }++instance Show RequiredVersion where+  show RequiredVersion {..} =+    unpack requiredVersionOp <> " " <> showVersion requiredVersionCompareWith++instance FromJSON RequiredVersion where+  parseJSON =+    withText "RequiredVersion" $ either fail pure . requiredVersionFromText++requiredVersionFromText :: Text -> Either String RequiredVersion+requiredVersionFromText = fromWords . T.words+ where+  fromWords :: [Text] -> Either String RequiredVersion+  fromWords = \case+    [w] -> parseRequiredVersion "=" w+    [op, w] -> parseRequiredVersion op w+    ws ->+      Left+        $ show (unpack $ T.unwords ws)+        <> " did not parse as optional operator and version string"++  parseRequiredVersion :: Text -> Text -> Either String RequiredVersion+  parseRequiredVersion op w = do+    v <- parseVersion w++    case op of+      "=" -> Right $ RequiredVersion op (==) v+      "<" -> Right $ RequiredVersion op (<) v+      "<=" -> Right $ RequiredVersion op (<=) v+      ">" -> Right $ RequiredVersion op (>) v+      ">=" -> Right $ RequiredVersion op (>=) v+      "=~" -> Right $ RequiredVersion op (=~) v+      _ ->+        Left+          $ "Invalid comparison operator ("+          <> unpack op+          <> "), may only be =, <, <=, >, >=, or =~"++  parseVersion :: Text -> Either String Version+  parseVersion t =+    fmap (fst . NE.last)+      $ note ("Failed to parse as a version " <> s)+      $ NE.nonEmpty+      $ readP_to_S Version.parseVersion s+    where s = unpack t++(=~) :: Version -> Version -> Bool+a =~ b = a >= b && a < incrementVersion b+ where+  incrementVersion = onVersion $ backwards $ onHead (+ 1)+  onVersion f = makeVersion . f . versionBranch+  backwards f = reverse . f . reverse+  onHead f as = maybe as (uncurry (:) . first f) $ uncons as++isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool+isRequiredVersionSatisfied RequiredVersion {..} =+  (`requiredVersionCompare` requiredVersionCompareWith)

@@ -3,7 +3,8 @@   , HasFilterOption(..)   , filterOption   , filterOptionFromPaths-  , filterFilePaths+  , filterOptionFromText+  , filterStackSpecs   ) where  import Stackctl.Prelude@@ -11,6 +12,9 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import Options.Applicative+import Stackctl.AWS.CloudFormation (StackName(..))+import Stackctl.StackSpec+import System.FilePath (hasExtension) import System.FilePath.Glob  newtype FilterOption = FilterOption@@ -39,15 +43,32 @@ filterOptionFromPaths :: NonEmpty FilePath -> FilterOption filterOptionFromPaths = FilterOption . fmap compile -readFilterOption :: String -> Either String FilterOption-readFilterOption =-  maybe (Left err) (Right . FilterOption)+filterOptionFromText :: Text -> Maybe FilterOption+filterOptionFromText =+  fmap FilterOption     . NE.nonEmpty-    . map (compile . unpack)+    . concatMap expandPatterns     . filter (not . T.null)     . map T.strip     . T.splitOn ","-    . pack++expandPatterns :: Text -> [Pattern]+expandPatterns t = map compile $ s : expanded+ where+  expanded+    | "**" `T.isPrefixOf` t = suffixed+    | otherwise = map ("**" </>) $ s : suffixed++  suffixed+    | "*" `T.isSuffixOf` t || hasExtension s = []+    | otherwise = (s </> "*") : map (s <.>) extensions++  extensions = ["json", "yaml"]++  s = unpack t++readFilterOption :: String -> Either String FilterOption+readFilterOption = note err . filterOptionFromText . pack   where err = "Must be non-empty, comma-separated list of non-empty patterns"  showFilterOption :: FilterOption -> String@@ -61,5 +82,13 @@ defaultFilterOption :: FilterOption defaultFilterOption = filterOptionFromPaths $ pure "**/*" -filterFilePaths :: FilterOption -> [FilePath] -> [FilePath]-filterFilePaths fo = filter $ \path -> any (`match` path) $ unFilterOption fo+filterStackSpecs :: FilterOption -> [StackSpec] -> [StackSpec]+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+  ]

@@ -9,6 +9,7 @@ import Options.Applicative import Stackctl.AWS import Stackctl.AWS.Scope+import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption (HasDirectoryOption(..)) import Stackctl.Spec.Generate import Stackctl.StackSpec@@ -66,6 +67,7 @@      , MonadReader env m      , HasAwsScope env      , HasAwsEnv env+     , HasConfig env      , HasDirectoryOption env      )   => CaptureOptions

@@ -20,6 +20,7 @@ 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@@ -58,6 +59,7 @@      , MonadReader env m      , HasLogger env      , HasAwsScope env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      , HasColorOption env@@ -100,7 +102,7 @@         pure $ ssyTemplate body    putTemplate 2 "templates/"-  for_ (sort $ concat $ concat templates) $ \template -> do+  for_ (sort $ nubOrd $ concat $ concat templates) $ \template -> do     val <- Yaml.decodeFileThrow @_ @Value $ dir </> "templates" </> template      putTemplate 4 $ green $ fromString template@@ -122,32 +124,44 @@ prettyPrintStackSpecYaml :: Colors -> StackName -> StackSpecYaml -> [Text] prettyPrintStackSpecYaml Colors {..} name StackSpecYaml {..} = concat   [ [cyan "Name" <> ": " <> green (unStackName name)]+  , maybe [] ppDescription ssyDescription   , [cyan "Template" <> ": " <> green (pack ssyTemplate)]-  , ppList "Parameters" (ppParameters . map unParameterYaml) ssyParameters+  , ppObject "Parameters" parametersYamlKVs ssyParameters   , ppList "Capabilities" ppCapabilities ssyCapabilities-  , ppList "Tags" (ppTags . map unTagYaml) ssyTags+  , ppObject "Tags" tagsYamlKVs ssyTags   ]  where+  ppObject :: Text -> (a -> [(Text, Maybe Text)]) -> Maybe a -> [Text]+  ppObject label f mA = fromMaybe [] $ do+    kvs <- f <$> mA+    pure+      $ [cyan label <> ":"]+      <> map+           (\(k, mV) ->+             "  " <> cyan k <> ":" <> maybe "" (\v -> " " <> green v) mV+           )+           kvs+   ppList :: Text -> (a -> [Text]) -> Maybe a -> [Text]   ppList label f = maybe [] (((cyan label <> ":") :) . f) -  ppParameters = concatMap $ \p ->-    [ "  - " <> cyan "ParameterKey" <> ": " <> maybe-      ""-      green-      (p ^. parameter_parameterKey)-    , "    " <> cyan "ParameterValue" <> ": " <> maybe-      ""-      toText-      (p ^. parameter_parameterValue)-    ]-+  ppDescription d =+    [cyan "Description" <> ": " <> green (unStackDescription d)]   ppCapabilities = map (("  - " <>) . green . toText) -  ppTags = concatMap $ \tg ->-    [ "  - " <> cyan "Key" <> ": " <> green (tg ^. tag_key)-    , "    " <> cyan "Value" <> ": " <> (tg ^. tag_value)-    ]+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++tagsYamlKVs :: TagsYaml -> [(Text, Maybe Text)]+tagsYamlKVs = map (tagKV . unTagYaml) . unTagsYaml++tagKV :: Tag -> (Text, Maybe Text)+tagKV tg = (tg ^. tag_key, tg ^. tag_value . to Just)  prettyPrintTemplate :: Colors -> Value -> [Text] prettyPrintTemplate Colors {..} val = concat

@@ -12,6 +12,7 @@ import Stackctl.AWS hiding (action) import Stackctl.AWS.Scope import Stackctl.Colors+import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption (HasDirectoryOption) import Stackctl.FilterOption (HasFilterOption) import Stackctl.ParameterOption@@ -47,6 +48,7 @@      , HasLogger env      , HasAwsScope env      , HasAwsEnv env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      )

@@ -11,10 +11,11 @@ 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) import Stackctl.FilterOption (HasFilterOption) import Stackctl.ParameterOption@@ -60,6 +61,7 @@      , HasLogger env      , HasAwsScope env      , HasAwsEnv env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      )

@@ -9,8 +9,9 @@ import qualified Data.List.NonEmpty as NE import Stackctl.AWS import Stackctl.AWS.Scope+import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption (HasDirectoryOption(..))-import Stackctl.FilterOption (HasFilterOption(..), filterFilePaths)+import Stackctl.FilterOption (HasFilterOption(..), filterStackSpecs) import Stackctl.StackSpec import Stackctl.StackSpecPath import System.FilePath (isPathSeparator)@@ -22,6 +23,7 @@      , MonadLogger m      , MonadReader env m      , HasAwsScope env+     , HasConfig env      , HasDirectoryOption env      , HasFilterOption env      )@@ -29,7 +31,7 @@ discoverSpecs = do   dir <- view directoryOptionL   scope@AwsScope {..} <- view awsScopeL-  discovered <- globRelativeTo+  paths <- globRelativeTo     dir     [ compile     $ "stacks"@@ -52,24 +54,27 @@   filterOption <- view filterOptionL    let-    matched = filterFilePaths filterOption discovered     toSpecPath = stackSpecPathFromFilePath scope-    (errs, specPaths) = partitionEithers $ map toSpecPath matched+    (errs, specPaths) = partitionEithers $ map toSpecPath paths      context =       [ "path" .= dir       , "filters" .= filterOption-      , "discovered" .= length discovered-      , "matched" .= length matched+      , "paths" .= length paths       , "errors" .= length errs+      , "specs" .= length specPaths       ]    withThreadContext context $ do-    logDebug "Discovered specs"-    when (null matched) $ logWarn "No specs found"     checkForDuplicateStackNames specPaths -  sortStackSpecs <$> traverse (readStackSpec dir) specPaths+    specs <-+      sortStackSpecs+      . filterStackSpecs filterOption+      <$> traverse (readStackSpec dir) specPaths++    when (null specs) $ logWarn "No specs found"+    specs <$ logDebug ("Discovered specs" :# ["matched" .= length specs])  checkForDuplicateStackNames   :: (MonadIO m, MonadLogger m) => [StackSpecPath] -> m ()

@@ -9,6 +9,7 @@ import Stackctl.Action import Stackctl.AWS import Stackctl.AWS.Scope+import Stackctl.Config (HasConfig) import Stackctl.Spec.Discover (buildSpecPath) import Stackctl.StackSpec import Stackctl.StackSpecPath@@ -41,6 +42,7 @@      , MonadUnliftIO m      , MonadLogger m      , MonadReader env m+     , HasConfig env      , HasAwsScope env      )   => Generate@@ -64,12 +66,12 @@       , ssyTemplate = templatePath       , ssyDepends = gDepends       , ssyActions = gActions-      , ssyParameters = map ParameterYaml <$> gParameters+      , ssyParameters = parametersYaml . mapMaybe parameterYaml <$> gParameters       , ssyCapabilities = gCapabilities-      , ssyTags = map TagYaml <$> gTags+      , ssyTags = tagsYaml . map TagYaml <$> gTags       } -    stackSpec = buildStackSpec gOutputDirectory specPath specYaml+  stackSpec <- buildStackSpec gOutputDirectory specPath specYaml    withThreadContext ["stackName" .= stackSpecStackName stackSpec] $ do     logInfo "Generating specification"

@@ -7,6 +7,8 @@   , stackSpecActions   , stackSpecParameters   , stackSpecCapabilities+  , stackSpecStackFile+  , stackSpecTemplateFile   , stackSpecTags   , buildStackSpec   , TemplateBody@@ -26,9 +28,11 @@ import qualified Data.Yaml as Yaml import Stackctl.Action import Stackctl.AWS+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 UnliftIO.Directory (createDirectoryIfMissing) @@ -56,22 +60,39 @@ stackSpecActions :: StackSpec -> [Action] stackSpecActions = fromMaybe [] . ssyActions . ssSpecBody -stackSpecTemplateFile :: StackSpec -> StackTemplate+-- | Normalized, relative path to the @[{root}/]stacks/@ file+stackSpecStackFile :: StackSpec -> FilePath+stackSpecStackFile StackSpec {..} =+  FilePath.normalise $ ssSpecRoot </> stackSpecPathFilePath ssSpecPath++-- | Normalized, relative path to the @[{root}/]templates/@ file+stackSpecTemplateFile :: StackSpec -> FilePath stackSpecTemplateFile StackSpec {..} =-  StackTemplate $ ssSpecRoot </> "templates" </> ssyTemplate ssSpecBody+  FilePath.normalise $ ssSpecRoot </> "templates" </> ssyTemplate ssSpecBody  stackSpecParameters :: StackSpec -> [Parameter] stackSpecParameters =-  maybe [] (map unParameterYaml) . ssyParameters . ssSpecBody+  maybe [] (map unParameterYaml . unParametersYaml) . ssyParameters . ssSpecBody  stackSpecCapabilities :: StackSpec -> [Capability] stackSpecCapabilities = fromMaybe [] . ssyCapabilities . ssSpecBody  stackSpecTags :: StackSpec -> [Tag]-stackSpecTags = maybe [] (map unTagYaml) . ssyTags . ssSpecBody+stackSpecTags = maybe [] (map unTagYaml . unTagsYaml) . ssyTags . ssSpecBody -buildStackSpec :: FilePath -> StackSpecPath -> StackSpecYaml -> StackSpec-buildStackSpec = StackSpec+buildStackSpec+  :: (MonadReader env m, HasConfig env)+  => FilePath+  -> StackSpecPath+  -> StackSpecYaml+  -> m StackSpec+buildStackSpec dir specPath specBody = do+  config <- view configL+  pure StackSpec+    { ssSpecRoot = dir+    , ssSpecPath = specPath+    , ssSpecBody = applyConfig config specBody+    }  data TemplateBody   = TemplateText Text@@ -117,18 +138,17 @@   createDirectoryIfMissing True $ takeDirectory specPath   liftIO $ Yaml.encodeFile specPath ssSpecBody  where-  templatePath = unStackTemplate $ stackSpecTemplateFile stackSpec+  templatePath = stackSpecTemplateFile stackSpec   specPath = parent </> stackSpecPathFilePath ssSpecPath -readStackSpec :: MonadIO m => FilePath -> StackSpecPath -> m StackSpec+readStackSpec+  :: (MonadIO m, MonadReader env m, HasConfig env)+  => FilePath+  -> StackSpecPath+  -> m StackSpec readStackSpec dir specPath = do   specBody <- liftIO $ either err pure =<< Yaml.decodeFileEither path--  pure StackSpec-    { ssSpecRoot = dir-    , ssSpecPath = specPath-    , ssSpecBody = specBody-    }+  buildStackSpec dir specPath specBody  where   path = dir </> stackSpecPathFilePath specPath   err e =@@ -148,7 +168,7 @@ createChangeSet spec parameters = awsCloudFormationCreateChangeSet   (stackSpecStackName spec)   (stackSpecStackDescription spec)-  (stackSpecTemplateFile spec)+  (StackTemplate $ stackSpecTemplateFile spec)   (nubOrdOn (^. parameter_parameterKey) $ parameters <> stackSpecParameters spec   )   (stackSpecCapabilities spec)

@@ -20,7 +20,15 @@ -- module Stackctl.StackSpecYaml   ( StackSpecYaml(..)-  , ParameterYaml(..)+  , ParametersYaml+  , parametersYaml+  , unParametersYaml+  , ParameterYaml+  , parameterYaml+  , unParameterYaml+  , TagsYaml+  , tagsYaml+  , unTagsYaml   , TagYaml(..)   ) where @@ -28,6 +36,11 @@  import Data.Aeson import Data.Aeson.Casing+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 qualified Data.Text as T import Stackctl.Action import Stackctl.AWS@@ -37,9 +50,9 @@   , ssyTemplate :: FilePath   , ssyDepends :: Maybe [StackName]   , ssyActions :: Maybe [Action]-  , ssyParameters :: Maybe [ParameterYaml]+  , ssyParameters :: Maybe ParametersYaml   , ssyCapabilities :: Maybe [Capability]-  , ssyTags :: Maybe [TagYaml]+  , ssyTags :: Maybe TagsYaml   }   deriving stock Generic @@ -50,20 +63,70 @@   toJSON = genericToJSON $ aesonPrefix id   toEncoding = genericToEncoding $ aesonPrefix id -newtype ParameterYaml = ParameterYaml-  { unParameterYaml :: Parameter+newtype ParametersYaml = ParametersYaml+  { unParametersYaml :: [ParameterYaml]   }+  deriving stock (Eq, Show)+  deriving newtype ToJSON +instance Semigroup ParametersYaml where+  ParametersYaml as <> ParametersYaml bs =+    ParametersYaml+      $ map (uncurry ParameterYaml)+      $ KeyMap.toList+      $ KeyMap.fromListWith (<>)+      $ map (pyKey &&& pyValue)+      $ bs -- flipped to make sure Last-wins+      <> as++instance FromJSON ParametersYaml where+  parseJSON = \case+    Object o -> do+      -- NB. There are simpler ways to do this, but making sure we construct+      -- things such that we use (.:) to read the value from each key means that+      -- 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 -> typeMismatch err v+   where+    err =+      "Object"+        <> ", list of {ParameterKey, ParameterValue} Objects"+        <> ", or list of {Key, Value} Objects"++parametersYaml :: [ParameterYaml] -> ParametersYaml+parametersYaml = ParametersYaml++data ParameterYaml = ParameterYaml+  { pyKey :: Key+  , pyValue :: Last ParameterValue+  }+  deriving stock (Eq, Show)++mkParameterYaml :: Text -> Maybe ParameterValue -> ParameterYaml+mkParameterYaml k = ParameterYaml (Key.fromText k) . Last++parameterYaml :: Parameter -> Maybe ParameterYaml+parameterYaml p = do+  k <- p ^. parameter_parameterKey+  let mv = p ^. parameter_parameterValue+  pure $ mkParameterYaml k $ ParameterValue <$> mv++unParameterYaml :: ParameterYaml -> Parameter+unParameterYaml (ParameterYaml k v) =+  makeParameter (Key.toText k) $ unParameterValue <$> getLast v+ instance FromJSON ParameterYaml where   parseJSON = withObject "Parameter" $ \o ->-    (build <$> o .: "Name" <*> o .: "Value")-      <|> (build <$> o .: "ParameterKey" <*> o .: "ParameterValue")-   where-    build k v = ParameterYaml $ makeParameter k $ Just $ unParameterValue v+    (mkParameterYaml <$> o .: "Name" <*> o .:? "Value")+      <|> (mkParameterYaml <$> o .: "ParameterKey" <*> o .:? "ParameterValue")  newtype ParameterValue = ParameterValue   { unParameterValue :: Text   }+  deriving stock (Eq, Show)+  deriving newtype (Semigroup, ToJSON)  instance FromJSON ParameterValue where   parseJSON = \case@@ -76,14 +139,46 @@   toEncoding = pairs . mconcat . parameterPairs  parameterPairs :: KeyValue a => ParameterYaml -> [a]-parameterPairs (ParameterYaml p) = fromMaybe [] $ do-  k <- p ^. parameter_parameterKey-  v <- p ^. parameter_parameterValue-  pure ["ParameterKey" .= k, "ParameterValue" .= v]+parameterPairs (ParameterYaml k v) = [k .= v] +newtype TagsYaml = TagsYaml+  { unTagsYaml :: [TagYaml]+  }+  deriving stock (Eq, Show)+  deriving newtype ToJSON++instance Semigroup TagsYaml where+  TagsYaml as <> TagsYaml bs =+    TagsYaml+      $ map (TagYaml . uncurry newTag)+      $ HashMap.toList+      $ HashMap.fromList+      $ map (toPair . unTagYaml)+      $ as+      <> bs+   where+    toPair :: Tag -> (Text, Text)+    toPair = (^. tag_key) &&& (^. tag_value)++instance FromJSON TagsYaml where+  parseJSON = \case+    Object o -> do+      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 -> typeMismatch err v+    where err = "Object or list of {Key, Value} Objects"++tagsYaml :: [TagYaml] -> TagsYaml+tagsYaml = TagsYaml+ newtype TagYaml = TagYaml   { unTagYaml :: Tag   }+  deriving newtype (Eq, Show)  instance FromJSON TagYaml where   parseJSON = withObject "Tag" $ \o -> do

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            stackctl-version:         1.1.2.2+version:         1.1.3.0 license:         MIT license-file:    LICENSE copyright:       2022 Renaissance Learning Inc@@ -33,6 +33,8 @@         Stackctl.ColorOption         Stackctl.Colors         Stackctl.Commands+        Stackctl.Config+        Stackctl.Config.RequiredVersion         Stackctl.DirectoryOption         Stackctl.FilterOption         Stackctl.Options@@ -99,6 +101,7 @@         lens,         lens-aeson,         monad-logger,+        mtl,         optparse-applicative,         resourcet,         rio,@@ -142,6 +145,8 @@     hs-source-dirs:     test     other-modules:         Stackctl.AWS.CloudFormationSpec+        Stackctl.Config.RequiredVersionSpec+        Stackctl.ConfigSpec         Stackctl.FilterOptionSpec         Stackctl.StackDescriptionSpec         Stackctl.StackSpecSpec@@ -166,7 +171,10 @@         -optP-Wno-nonportable-include-path      build-depends:+        QuickCheck,         base >=4 && <5,+        bytestring,         hspec,+        mtl,         stackctl,         yaml

@@ -0,0 +1,80 @@+module Stackctl.Config.RequiredVersionSpec+  ( spec+  ) where++import Stackctl.Prelude++import Data.Version+import Stackctl.Config.RequiredVersion+import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec = do+  describe "requiredVersionFromText" $ do+    it "parses with or without operator" $ do+      requiredVersionFromText "1.2.3-rc1" `shouldSatisfy` isRight+      requiredVersionFromText "= 1.2.3-rc1" `shouldSatisfy` isRight++    it "rejects unknown operators" $ do+      requiredVersionFromText "!! 1.2.3" `shouldSatisfy` isLeft++    it "rejects invalid versions" $ do+      requiredVersionFromText "= wowOMG-2/2" `shouldSatisfy` isLeft++  describe "parsing operators" $ do+    let prop cmp = property . uncurry . compareAsRequiredVersion cmp++    it "compares exactly" $ prop (==) Nothing+    it "compares with = " $ prop (==) $ Just "="+    it "compares with < " $ prop (<) $ Just "<"+    it "compares with <=" $ prop (<=) $ Just "<="+    it "compares with > " $ prop (>) $ Just ">"+    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++    it "treats older versions as non-satisfying" $ do+      makeVersion [1, 2, 2] =~ makeVersion [1, 2, 3] `shouldBe` False++    it "treats newer versions of the same branch as satisfying" $ do+      makeVersion [1, 2, 3, 1] =~ makeVersion [1, 2, 3] `shouldBe` True++    it "treats newer versions as non-satisfying" $ do+      makeVersion [1, 2, 4] =~ makeVersion [1, 2, 3] `shouldBe` False++    it "respects the number of components specified" $ do+      makeVersion [1, 2] =~ makeVersion [1, 2] `shouldBe` True+      makeVersion [1, 2, 3] =~ makeVersion [1, 2] `shouldBe` True+      makeVersion [1, 1] =~ makeVersion [1, 2] `shouldBe` False+      makeVersion [1, 3] =~ makeVersion [1, 2, 3] `shouldBe` False++compareAsRequiredVersion+  :: (Version -> Version -> Bool)+  -- ^ Reference compare+  -> Maybe Text+  -- ^ Operator+  -> Version+  -- ^ Hypothetical required version+  -> Version+  -- ^ Hypotehtical current version+  -> Bool+compareAsRequiredVersion cmp mOperator required current =+  runRequiredVersion mOperator required current+    == Right (current `cmp` required)++runRequiredVersion+  :: Maybe Text+  -- ^ Operator+  -> Version+  -- ^ Hypothetical required version+  -> Version+  -- ^ Hypothetical current version+  -> Either String Bool+runRequiredVersion mOperator required current =+  (`isRequiredVersionSatisfied` current) <$> requiredVersionFromText rvText+  where rvText = maybe "" (<> " ") mOperator <> pack (showVersion required)

@@ -0,0 +1,75 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++module Stackctl.ConfigSpec+  ( spec+  ) where++import Stackctl.Prelude++import Control.Monad.Except+import qualified Data.ByteString.Char8 as BS8+import Data.Version (showVersion)+import Paths_stackctl as Paths+import Stackctl.AWS (makeParameter, newTag)+import Stackctl.Config+import Stackctl.StackSpecYaml+import Test.Hspec++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"+          ]++      case result of+        Left err -> do+          expectationFailure+            $ "Expected to load a Config, got error: "+            <> show err+        Right config -> do+          configParameters config+            `shouldBe` Just (toParametersYaml [("Some", Just "Parameter")])+          configTags config `shouldBe` Just (toTagsYaml [("Some", "Tag")])++  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")]+          }++        Right config =+          loadConfigFromBytes+            $ "defaults:"+            <> "\n  tags:"+            <> "\n    From: Defaults"+            <> "\n    Keep: \"You?\""++        Just tags = ssyTags (applyConfig config specYaml)++      tags `shouldBe` toTagsYaml+        [("From", "Defaults"), ("Hi", "There"), ("Keep", "Me")]++loadConfigFromLines :: MonadError ConfigError m => [ByteString] -> m Config+loadConfigFromLines = loadConfigFromBytes . mconcat . map (<> "\n")++toParametersYaml :: [(Text, Maybe Text)] -> ParametersYaml+toParametersYaml =+  parametersYaml . mapMaybe (parameterYaml . uncurry makeParameter)++toTagsYaml :: [(Text, Text)] -> TagsYaml+toTagsYaml = tagsYaml . map (TagYaml . uncurry newTag)

@@ -1,35 +1,114 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module Stackctl.FilterOptionSpec   ( spec   ) where  import Stackctl.Prelude +import Stackctl.AWS+import Stackctl.AWS.Scope+import Stackctl.Config (emptyConfig) import Stackctl.FilterOption+import Stackctl.StackSpec+import Stackctl.StackSpecPath+import Stackctl.StackSpecYaml import Test.Hspec  spec :: Spec spec = do-  describe "filterFilePaths" $ do-    it "filters paths matching any of the given patterns" $ do+  describe "filterStackSpecs" $ do+    it "filters specs matching any of the given patterns" $ do       let-        option =-          filterOptionFromPaths $ "some-path" :| ["prefix/*", "**/suffix"]-        paths =-          [ "some-path"-          , "some-path-other"-          , "other-some-path"-          , "prefix/foo"-          , "prefix/foo-bar"-          , "prefix/foo-bar/prefix"-          , "foo/suffix"-          , "foo/bar/suffix"-          , "foo/suffix/bar"+        Just option = filterOptionFromText "**/some-path,**/prefix/*,**/suffix"+        specs =+          [ toSpec "some-path" "some-path" Nothing+          , toSpec "some-other-path" "some-path-other" Nothing+          , toSpec "other-some-path" "other-some-path" Nothing+          , toSpec "prefix-foo" "prefix/foo" Nothing+          , toSpec "prefix-foo-bar" "prefix/foo-bar" Nothing+          , toSpec "prefix-foo-bar-prefix" "prefix/foo-bar/prefix" Nothing+          , toSpec "foo-suffix" "foo/suffix" Nothing+          , toSpec "foo-bar-suffix" "foo/bar/suffix" Nothing+          , toSpec "foo-suffix-bar" "foo/suffix/bar" Nothing           ] -      filterFilePaths option paths+      map specName (filterStackSpecs option specs)         `shouldMatchList` [ "some-path"-                          , "prefix/foo"-                          , "prefix/foo-bar"-                          , "foo/suffix"-                          , "foo/bar/suffix"+                          , "prefix-foo"+                          , "prefix-foo-bar"+                          , "foo-suffix"+                          , "foo-bar-suffix"+                          , "foo-suffix-bar"                           ]++    it "filters specs by template too" $ do+      let+        Just option = filterOptionFromText "templates/x,**/y/*"+        specs =+          [ toSpec "some-path" "some-path" Nothing+          , toSpec "some-other-path" "some-path-other" $ Just "x"+          , toSpec "prefix-foo" "prefix/foo" Nothing+          , toSpec "other-some-path" "other-some-path" $ Just "z/y/t"+          , toSpec "prefix-foo-bar" "prefix/foo-bar" Nothing+          ]++      map specName (filterStackSpecs option specs)+        `shouldMatchList` ["some-other-path", "other-some-path"]++    it "filters specs by name too" $ do+      let+        Just option = filterOptionFromText "some-name,**/prefix/*,templates/x"+        specs =+          [ toSpec "some-name" "some-path" Nothing+          , toSpec "some-path" "some-path-other" $ Just "x"+          , toSpec "prefix-foo" "prefix/foo" Nothing+          , toSpec "other-some-path" "other-some-path" $ Just "z/y/t"+          , toSpec "prefix-foo-bar" "prefix/foo-bar" Nothing+          ]++      map specName (filterStackSpecs option specs)+        `shouldMatchList` [ "some-name"+                          , "some-path"+                          , "prefix-foo"+                          , "prefix-foo-bar"+                          ]++    it "adds some intuitive fuzziness" $ do+      let+        Just option = filterOptionFromText "some/path,file,file.ext"+        specs =+          [ toSpec "some-name" "x/some/path/y" Nothing+          , toSpec "some-path" "some-path/other" $ Just "x"+          , toSpec "prefix-foo" "prefix/file.json" Nothing+          , toSpec "other-some-path" "other-some-path" $ Just "z/y/t"+          , toSpec "prefix-foo-bar" "prefix/foo-bar" Nothing+          ]++      map specName (filterStackSpecs option specs)+        `shouldMatchList` ["some-name", "prefix-foo"]++toSpec :: Text -> FilePath -> Maybe FilePath -> StackSpec+toSpec name path mTemplate = flip runReader emptyConfig+  $ buildStackSpec "." 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"+    }++specName :: StackSpec -> Text+specName = unStackName . stackSpecStackName

@@ -6,6 +6,7 @@  import Stackctl.AWS import Stackctl.AWS.Scope+import Stackctl.Config (emptyConfig) import Stackctl.StackSpec import Stackctl.StackSpecPath import Stackctl.StackSpecYaml@@ -27,7 +28,8 @@         `shouldBe` ["iam", "roles", "networking", "app"]  toSpec :: Text -> [Text] -> StackSpec-toSpec name depends = buildStackSpec "." specPath specBody+toSpec name depends = flip runReader emptyConfig+  $ buildStackSpec "." specPath specBody  where   stackName = StackName name   specPath = stackSpecPath scope stackName "a/b.yaml"

@@ -22,7 +22,8 @@         , "    ParameterValue: Bar\n"         ] -      let Just [ParameterYaml param] = ssyParameters+      let+        Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters       param ^. parameter_parameterKey `shouldBe` Just "Foo"       param ^. parameter_parameterValue `shouldBe` Just "Bar" @@ -34,7 +35,8 @@         , "    ParameterValue: 80\n"         ] -      let Just [ParameterYaml param] = ssyParameters+      let+        Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters       param ^. parameter_parameterKey `shouldBe` Just "Port"       param ^. parameter_parameterValue `shouldBe` Just "80" @@ -46,7 +48,8 @@         , "    ParameterValue: 3.14\n"         ] -      let Just [ParameterYaml param] = ssyParameters+      let+        Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters       param ^. parameter_parameterKey `shouldBe` Just "Pie"       param ^. parameter_parameterValue `shouldBe` Just "3.14" @@ -62,6 +65,36 @@       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"]++      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+      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"]++      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"@@ -70,6 +103,42 @@         , "    Value: Bar\n"         ] -      let Just [ParameterYaml param] = ssyParameters+      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"]++      let+        Just [param] = map unParameterYaml . unParametersYaml <$> ssyParameters+      param ^. parameter_parameterKey `shouldBe` Just "Foo"+      param ^. parameter_parameterValue `shouldBe` Just "Bar"++  describe "ParametersYaml" $ 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]++      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+        a = tagsYaml []+        b = tagsYaml [TagYaml $ newTag "Key" "B"]+        c = tagsYaml [TagYaml $ newTag "Key" "C"]++      a <> b `shouldBe` b -- keeps keys in B+      b <> c `shouldBe` c -- C overrides B (Last)