Repository-local configuration

If present, `./.stackctl/config.yaml` is read on startup and loaded into
an application `Config` value. This configuration provides two
abilities:

- To specify a version requirement, in case your specs are relying on
  certain Stackctl features and/or bugfixes and you'd like to fully
  ensure behaviors in both local and CI contexts

- To specify some `defaults`: `Parameters` or `Tags` that should be
  applied to all Stacks deployed from this location. For example, `App`,
  `Owner`, or `DeployedBy`. It's tedious and error-prone to have to
  specify repeated things in every specification.

The config currently look like this (all values optional):

```yaml
required_version: <RequiredVersion>

defaults:
  parameters:
    <ParametersYaml>

  tags:
    <TagsYaml>
```

And here is an example:

```yaml
required_version: =~ 1.2

defaults:
  parameters:
    App: my-cool-app

  tags:
    Owner: my-cool-team
```

To support this,

- `RequiredVersion` was built and tested
- `ParametersYaml` and `TagsYaml` were given "last-wins" `Semigroup`
  instances
- `Config` and `HasConfig` were built
- `StackSpec` construction was centralized in `buildStackSpec`, which
  grew a `HasConfig` constraint, which it now uses to apply `defaults`
  for every `StackSpec` we ever construct

package.yaml

@@ -79,6 +79,7 @@ library:
     - lens
     - lens-aeson
     - monad-logger
+    - mtl
     - optparse-applicative
     - resourcet
     - rio
@@ -106,6 +107,9 @@ tests:
     main: Spec.hs
     source-dirs: test
     dependencies:
+      - QuickCheck
+      - bytestring
       - hspec
+      - mtl
       - stackctl
       - yaml

src/Stackctl/CLI.hs

@@ -13,12 +13,14 @@ import Control.Monad.Trans.Resource (ResourceT, runResourceT)
 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 @@ optionsL = lens appOptions $ \x y -> x { appOptions = y }
 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 @@ runAppT options f = do
     (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

src/Stackctl/Commands.hs

@@ -11,6 +11,7 @@ import Stackctl.Prelude
 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 @@ import Stackctl.Version
 cat
   :: ( HasLogger env
      , HasAwsScope env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      , HasColorOption env
@@ -36,7 +38,7 @@ cat = Subcommand
   }
 
 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 @@ changes
   :: ( HasLogger env
      , HasAwsScope env
      , HasAwsEnv env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      )
@@ -64,6 +67,7 @@ deploy
   :: ( HasLogger env
      , HasAwsScope env
      , HasAwsEnv env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      )

src/Stackctl/Config.hs

@@ -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"
+  ]

src/Stackctl/Config/RequiredVersion.hs

@@ -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)

src/Stackctl/Spec/Capture.hs

@@ -9,6 +9,7 @@ import Stackctl.Prelude
 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 @@ runCapture
      , MonadReader env m
      , HasAwsScope env
      , HasAwsEnv env
+     , HasConfig env
      , HasDirectoryOption env
      )
   => CaptureOptions

src/Stackctl/Spec/Cat.hs

@@ -20,6 +20,7 @@ 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
@@ -58,6 +59,7 @@ runCat
      , MonadReader env m
      , HasLogger env
      , HasAwsScope env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      , HasColorOption env

src/Stackctl/Spec/Changes.hs

@@ -12,6 +12,7 @@ import Options.Applicative
 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 @@ runChanges
      , HasLogger env
      , HasAwsScope env
      , HasAwsEnv env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      )

src/Stackctl/Spec/Deploy.hs

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

src/Stackctl/Spec/Discover.hs

@@ -9,6 +9,7 @@ import Data.List.Extra (dropPrefix)
 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(..), filterStackSpecs)
 import Stackctl.StackSpec
@@ -22,6 +23,7 @@ discoverSpecs
      , MonadLogger m
      , MonadReader env m
      , HasAwsScope env
+     , HasConfig env
      , HasDirectoryOption env
      , HasFilterOption env
      )