diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,13 @@ -## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.6.1.2...main) +## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.7.0.0...main) + +## [v1.7.0.0](https://github.com/freckle/stackctl/compare/v1.6.1.2...v1.7.0.0) + +- Retain numeric parameter types, and add boolean parameter handling, in our own + yaml generation + + This required changing the `Generate` to use `ParametersYaml` instead of + `[Parameter]`, and ultimately led us to removing it, hence the major version + bump. ## [v1.6.1.2](https://github.com/freckle/stackctl/compare/v1.6.1.1...v1.6.1.2) diff --git a/src/Stackctl/Spec/Capture.hs b/src/Stackctl/Spec/Capture.hs --- a/src/Stackctl/Spec/Capture.hs +++ b/src/Stackctl/Spec/Capture.hs @@ -13,6 +13,13 @@ import Stackctl.DirectoryOption (HasDirectoryOption) import Stackctl.Spec.Generate import Stackctl.StackSpec +import Stackctl.StackSpecYaml + ( StackSpecYaml (..) + , TagYaml (..) + , parameterYaml + , parametersYaml + , tagsYaml + ) import System.FilePath.Glob data CaptureOptions = CaptureOptions @@ -91,7 +98,7 @@ setScopeName scope = maybe scope (\name -> scope {awsAccountName = name}) scoAccountName - generate' stack template path templatePath = do + generate' stack template mPath mTemplatePath = do let stackName = StackName $ stack ^. stack_stackName templateBody = templateBodyFromValue template @@ -99,21 +106,26 @@ 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 - } + False + ( case mPath of + Nothing -> GenerateSpec stackName + Just sp -> GenerateSpecTo stackName sp + ) + ( case mTemplatePath of + Nothing -> GenerateTemplate templateBody scoTemplateFormat + Just tp -> GenerateTemplateTo templateBody tp + ) + ( \templatePath -> + StackSpecYaml + { ssyDescription = stackDescription stack + , ssyTemplate = templatePath + , ssyDepends = scoDepends + , ssyActions = Nothing + , ssyParameters = parametersYaml . mapMaybe parameterYaml <$> parameters stack + , ssyCapabilities = capabilities stack + , ssyTags = tagsYaml . map TagYaml <$> tags stack + } + ) results <- awsCloudFormationGetStackNamesMatching scoStackName diff --git a/src/Stackctl/Spec/Generate.hs b/src/Stackctl/Spec/Generate.hs --- a/src/Stackctl/Spec/Generate.hs +++ b/src/Stackctl/Spec/Generate.hs @@ -1,6 +1,5 @@ module Stackctl.Spec.Generate - ( Generate (..) - , GenerateSpec (..) + ( GenerateSpec (..) , GenerateTemplate (..) , generate , TemplateFormat (..) @@ -10,7 +9,6 @@ import Stackctl.AWS import Stackctl.AWS.Scope -import Stackctl.Action import Stackctl.Config (HasConfig) import Stackctl.DirectoryOption import Stackctl.Spec.Discover (buildSpecPath) @@ -18,18 +16,6 @@ import Stackctl.StackSpecPath import Stackctl.StackSpecYaml -data Generate = Generate - { gDescription :: Maybe StackDescription - , gDepends :: Maybe [StackName] - , gActions :: Maybe [Action] - , gParameters :: Maybe [Parameter] - , gCapabilities :: Maybe [Capability] - , gTags :: Maybe [Tag] - , gSpec :: GenerateSpec - , gTemplate :: GenerateTemplate - , gOverwrite :: Bool - } - data GenerateSpec = -- | Generate at an inferred name GenerateSpec StackName @@ -57,15 +43,18 @@ , HasAwsScope env , HasDirectoryOption env ) - => Generate + => Bool + -> GenerateSpec + -> GenerateTemplate + -> (FilePath -> StackSpecYaml) -> m FilePath -generate Generate {..} = do +generate overwrite spec template toStackSpecYaml = do let - (stackName, stackPath) = case gSpec of + (stackName, stackPath) = case spec of GenerateSpec name -> (name, unpack (unStackName name) <> ".yaml") GenerateSpecTo name path -> (name, path) - (mTemplateBody, templatePath) = case gTemplate of + (mTemplateBody, templatePath) = case template of GenerateTemplate body format -> ( Just body , case format of @@ -75,21 +64,12 @@ 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 = toStackSpecYaml templatePath dir <- view $ directoryOptionL . to unDirectoryOption specPath <- buildSpecPath stackName stackPath stackSpec <- buildStackSpec dir specPath specYaml withThreadContext ["stackName" .= stackSpecStackName stackSpec] $ do - writeStackSpec gOverwrite stackSpec mTemplateBody + writeStackSpec overwrite stackSpec mTemplateBody pure $ stackSpecPathFilePath specPath diff --git a/src/Stackctl/StackSpecYaml.hs b/src/Stackctl/StackSpecYaml.hs --- a/src/Stackctl/StackSpecYaml.hs +++ b/src/Stackctl/StackSpecYaml.hs @@ -4,18 +4,24 @@ -- Template: -- -- Depends: --- - +-- - -- -- Parameters: --- - ParameterKey: --- ParameterValue: +-- - ParameterKey: +-- ParameterValue: -- +-- # Or +-- : +-- -- Capabilities: --- - +-- - -- -- Tags: --- - Key: --- Value: +-- - Key: +-- Value: +-- +-- # Or +-- : -- @ module Stackctl.StackSpecYaml ( StackSpecYaml (..) @@ -24,7 +30,11 @@ , unParametersYaml , ParameterYaml , parameterYaml + , mkParameterYaml , unParameterYaml + , ParameterValue + , parameterValueFromText + , parameterValueTemplate , TagsYaml , tagsYaml , unTagsYaml @@ -39,6 +49,7 @@ import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.Types (typeMismatch) import qualified Data.HashMap.Strict as HashMap +import Data.List.Extra (dropSuffix) import Data.Monoid (Last (..)) import qualified Data.Text as T import Stackctl.AWS @@ -117,31 +128,81 @@ parameterYamlPair :: KeyValue kv => ParameterYaml -> kv parameterYamlPair ParameterYaml {..} = pyKey .= pyValue -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 + pure $ mkParameterYaml k $ parameterValueFromText <$> mv +mkParameterYaml :: Text -> Maybe ParameterValue -> ParameterYaml +mkParameterYaml k = ParameterYaml (Key.fromText k) . Last + unParameterYaml :: ParameterYaml -> Parameter unParameterYaml (ParameterYaml k v) = - makeParameter (Key.toText k) $ unParameterValue <$> getLast v + makeParameter (Key.toText k) $ parameterValueToText <$> getLast v -newtype ParameterValue = ParameterValue - { unParameterValue :: Text - } +data ParameterValue + = StringParameter Text + | NumberParameter Double + | -- | Encodes as String True|False + BooleanParameter Bool deriving stock (Eq, Show) - deriving newtype (Semigroup, ToJSON) instance FromJSON ParameterValue where parseJSON = \case - String x -> pure $ ParameterValue x - Number x -> pure $ ParameterValue $ dropSuffix ".0" $ pack $ show x - x -> fail $ "Expected String or Number, got: " <> show x + String t -> pure $ StringParameter t + Number s -> pure $ NumberParameter $ realToFrac s + Bool b -> pure $ BooleanParameter b + x -> typeMismatch "String, Number or Bool" x +instance ToJSON ParameterValue where + toJSON = \case + StringParameter t -> toJSON t + NumberParameter d -> toJSON d + BooleanParameter b -> toJSON $ pack $ show b + toEncoding = \case + StringParameter t -> toEncoding t + NumberParameter d -> toEncoding d + BooleanParameter b -> toEncoding $ pack $ show b + +parameterValueToText :: ParameterValue -> Text +parameterValueToText = \case + StringParameter t -> t + NumberParameter d -> pack $ dropSuffix ".0" $ show d + BooleanParameter b -> pack $ show b + +parameterValueFromText :: Text -> ParameterValue +parameterValueFromText = \case + v | T.toLower v == "true" -> BooleanParameter True + v | T.toLower v == "false" -> BooleanParameter False + v | Just d <- readMaybe (unpack v) -> NumberParameter d + v -> StringParameter v + +-- | For use as the value in a @Parameters@ object of a CFN Template +parameterValueTemplate :: ParameterValue -> Value +parameterValueTemplate v = + object + $ catMaybes + [ Just $ "Type" .= parameterValueType v + , Just $ "Default" .= parameterValueDefault v + , ("AllowedValues" .=) <$> parameterValueAllowedValues v + ] + +parameterValueType :: ParameterValue -> Text +parameterValueType = \case + StringParameter {} -> "String" + NumberParameter {} -> "Number" + BooleanParameter {} -> "String" + +parameterValueDefault :: ParameterValue -> Value +parameterValueDefault = toJSON + +parameterValueAllowedValues :: ParameterValue -> Maybe Value +parameterValueAllowedValues = \case + StringParameter {} -> Nothing + NumberParameter {} -> Nothing + BooleanParameter {} -> Just $ toJSON [String "True", String "False"] + newtype TagsYaml = TagsYaml { unTagsYaml :: [TagYaml] } @@ -194,6 +255,3 @@ tagYamlPair :: KeyValue kv => TagYaml -> kv tagYamlPair (TagYaml t) = Key.fromText (t ^. tag_key) .= (t ^. tag_value) - -dropSuffix :: Text -> Text -> Text -dropSuffix suffix t = fromMaybe t $ T.stripSuffix suffix t diff --git a/stackctl.cabal b/stackctl.cabal --- a/stackctl.cabal +++ b/stackctl.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: stackctl -version: 1.6.1.2 +version: 1.7.0.0 license: MIT license-file: LICENSE copyright: 2022 Renaissance Learning Inc diff --git a/test/Stackctl/StackSpecYamlSpec.hs b/test/Stackctl/StackSpecYamlSpec.hs --- a/test/Stackctl/StackSpecYamlSpec.hs +++ b/test/Stackctl/StackSpecYamlSpec.hs @@ -80,28 +80,6 @@ param ^. parameter_parameterKey `shouldBe` Just "Pie" param ^. parameter_parameterValue `shouldBe` Just "3.14" - it "has informative errors" $ do - let Left ex = - Yaml.decodeEither' @StackSpecYaml - $ mconcat - [ "Template: foo.yaml\n" - , "Parameters:\n" - , " - ParameterKey: Norway\n" - , " ParameterValue: no\n" - ] - - show ex - `shouldBe` "AesonException \"Error in $.Parameters[0].ParameterValue: Expected String or Number, got: Bool False\"" - - it "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