stackctl 1.1.3.0 → 1.1.3.1

raw patch · 14 files changed

+109/−57 lines, 14 files

Files

• CHANGELOG.md +5/−1
• src/Stackctl/AWS/CloudFormation.hs +7/−2
• src/Stackctl/AWS/Core.hs +2/−4
• src/Stackctl/AWS/Scope.hs +1/−1
• src/Stackctl/Action.hs +6/−6
• src/Stackctl/Prelude.hs +1/−1
• src/Stackctl/Prompt.hs +1/−1
• src/Stackctl/Spec/Generate.hs +1/−1
• src/Stackctl/StackSpec.hs +23/−17
• src/Stackctl/StackSpecPath.hs +1/−0
• src/Stackctl/StackSpecYaml.hs +25/−21
• stackctl.cabal +2/−1
• test/Stackctl/FilterOptionSpec.hs +14/−1
• test/Stackctl/StackSpecYamlSpec.hs +20/−0

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.3.0...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.3.1...main)++## [v1.1.3.1](https://github.com/freckle/stackctl/compare/v1.1.3.0...v1.1.3.1)++- Fix JSON formatting bugs in generating specification  ## [v1.1.3.0](https://github.com/freckle/stackctl/compare/v1.1.2.2...v1.1.3.0) 

@@ -115,7 +115,7 @@   { unStackTemplate :: FilePath   }   deriving stock (Eq, Show)-  deriving newtype FromJSON+  deriving newtype (FromJSON, ToJSON)  data StackDeployResult   = StackCreateSuccess@@ -343,10 +343,13 @@     $ trying (_ServiceError . hasStatus 400)     $ do         name <- newChangeSetName++        logDebug $ "Reading Template" :# ["path" .= stackTemplate]         templateBody <- addStackDescription mStackDescription           <$> readFileUtf8 (unStackTemplate stackTemplate)          mStack <- awsCloudFormationDescribeStackMaybe stackName+         let           changeSetType = fromMaybe ChangeSetType_CREATE $ do             stack <- mStack@@ -363,7 +366,9 @@               . (createChangeSet_capabilities ?~ capabilities)               . (createChangeSet_tags ?~ tags) -        logInfo "Creating changeset..."+        logInfo+          $ "Creating changeset..."+          :# ["name" .= name, "type" .= changeSetType]         csId <- awsSimple "CreateChangeSet" req (^. createChangeSetResponse_id)          logDebug "Awaiting CREATE_COMPLETE"

@@ -1,7 +1,5 @@ module Stackctl.AWS.Core-  (-  -- * AWS via 'MonadReader'-    AwsEnv+  ( AwsEnv   , HasAwsEnv(..)   , awsEnvDiscover   , awsSimple@@ -111,4 +109,4 @@ newtype AccountId = AccountId   { unAccountId :: Text   }-  deriving newtype (Eq, Ord, ToJSON)+  deriving newtype (Eq, Ord, Show, ToJSON)

@@ -14,7 +14,7 @@   , awsAccountName :: Text   , awsRegion :: Region   }-  deriving stock Generic+  deriving stock (Eq, Show, Generic)   deriving anyclass ToJSON  class HasAwsScope env where

@@ -31,14 +31,14 @@   { on :: ActionOn   , run :: ActionRun   }-  deriving stock Generic+  deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON)  newAction :: ActionOn -> ActionRun -> Action newAction = Action  data ActionOn = PostDeploy-  deriving stock (Eq, Generic)+  deriving stock (Eq, Show, Generic)  instance FromJSON ActionOn where   parseJSON = withText "ActionOn" $ \case@@ -55,12 +55,12 @@ data ActionRun   = InvokeLambdaByStackOutput Text   | InvokeLambdaByName Text+  deriving stock (Eq, Show)  instance FromJSON ActionRun where-  parseJSON = withObject "ActionRun" $ \o -> asum-    [ InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByStackOutput"-    , InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByName"-    ]+  parseJSON = withObject "ActionRun" $ \o ->+    (InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByStackOutput")+      <|> (InvokeLambdaByName <$> o .: "InvokeLambdaByName")  instance ToJSON ActionRun where   toJSON = object . \case

@@ -26,7 +26,7 @@   (dropExtension, takeBaseName, takeDirectory, (<.>), (</>)) import UnliftIO.Directory as X (withCurrentDirectory) -{-# ANN module ("HLint: ignore Avoid restricted qualification" :: String) #-}+{-# ANN module ("HLint: ignore Avoid restricted alias" :: String) #-}  decodeUtf8 :: ByteString -> Text decodeUtf8 = decodeUtf8With lenientDecode

@@ -41,4 +41,4 @@     | x `elem` ["n", "N"] = Right False     | otherwise = Left $ "Must be y, Y, n, or N (saw " <> x <> ")" -  dispatch b = if b then pure () else exitSuccess+  dispatch b = unless b exitSuccess

@@ -75,5 +75,5 @@    withThreadContext ["stackName" .= stackSpecStackName stackSpec] $ do     logInfo "Generating specification"-    writeStackSpec gOutputDirectory stackSpec gTemplateBody+    writeStackSpec stackSpec gTemplateBody     pure $ stackSpecPathFilePath specPath

@@ -42,6 +42,9 @@   , ssSpecBody :: StackSpecYaml   } +stackSpecSpecRoot :: StackSpec -> FilePath+stackSpecSpecRoot = ssSpecRoot+ stackSpecSpecPath :: StackSpec -> StackSpecPath stackSpecSpecPath = ssSpecPath @@ -60,16 +63,21 @@ stackSpecActions :: StackSpec -> [Action] stackSpecActions = fromMaybe [] . ssyActions . ssSpecBody --- | Normalized, relative path to the @[{root}/]stacks/@ file+-- | Relative path @stacks/...@ stackSpecStackFile :: StackSpec -> FilePath-stackSpecStackFile StackSpec {..} =-  FilePath.normalise $ ssSpecRoot </> stackSpecPathFilePath ssSpecPath+stackSpecStackFile = stackSpecPathFilePath . ssSpecPath --- | Normalized, relative path to the @[{root}/]templates/@ file+-- | Relative path @templates/...@ stackSpecTemplateFile :: StackSpec -> FilePath-stackSpecTemplateFile StackSpec {..} =-  FilePath.normalise $ ssSpecRoot </> "templates" </> ssyTemplate ssSpecBody+stackSpecTemplateFile = ("templates" </>) . ssyTemplate . ssSpecBody +stackSpecTemplate :: StackSpec -> StackTemplate+stackSpecTemplate spec =+  StackTemplate+    $ FilePath.normalise+    $ ssSpecRoot spec+    </> stackSpecTemplateFile spec+ stackSpecParameters :: StackSpec -> [Parameter] stackSpecParameters =   maybe [] (map unParameterYaml . unParametersYaml) . ssyParameters . ssSpecBody@@ -127,19 +135,17 @@   dir = takeDirectory path   ext = takeExtension path -writeStackSpec-  :: MonadUnliftIO m-  => FilePath -- ^ Parent directory-  -> StackSpec-  -> TemplateBody-  -> m ()-writeStackSpec parent stackSpec@StackSpec {..} templateBody = do+writeStackSpec :: MonadUnliftIO m => StackSpec -> TemplateBody -> m ()+writeStackSpec stackSpec templateBody = do   writeTemplateBody templatePath templateBody   createDirectoryIfMissing True $ takeDirectory specPath-  liftIO $ Yaml.encodeFile specPath ssSpecBody+  liftIO $ Yaml.encodeFile specPath $ stackSpecSpecBody stackSpec  where-  templatePath = stackSpecTemplateFile stackSpec-  specPath = parent </> stackSpecPathFilePath ssSpecPath+  templatePath = unStackTemplate $ stackSpecTemplate stackSpec+  specPath =+    FilePath.normalise+      $ stackSpecSpecRoot stackSpec+      </> stackSpecStackFile stackSpec  readStackSpec   :: (MonadIO m, MonadReader env m, HasConfig env)@@ -168,7 +174,7 @@ createChangeSet spec parameters = awsCloudFormationCreateChangeSet   (stackSpecStackName spec)   (stackSpecStackDescription spec)-  (StackTemplate $ stackSpecTemplateFile spec)+  (stackSpecTemplate spec)   (nubOrdOn (^. parameter_parameterKey) $ parameters <> stackSpecParameters spec   )   (stackSpecCapabilities spec)

@@ -30,6 +30,7 @@   , sspStackName :: StackName   , sspPath :: FilePath   }+  deriving stock (Eq, Show)  stackSpecPath :: AwsScope -> StackName -> FilePath -> StackSpecPath stackSpecPath sspAwsScope@AwsScope {..} sspStackName sspPath = StackSpecPath

@@ -54,7 +54,7 @@   , ssyCapabilities :: Maybe [Capability]   , ssyTags :: Maybe TagsYaml   }-  deriving stock Generic+  deriving stock (Eq, Show, Generic)  instance FromJSON StackSpecYaml where   parseJSON = genericParseJSON $ aesonPrefix id@@ -67,7 +67,6 @@   { unParametersYaml :: [ParameterYaml]   }   deriving stock (Eq, Show)-  deriving newtype ToJSON  instance Semigroup ParametersYaml where   ParametersYaml as <> ParametersYaml bs =@@ -95,6 +94,13 @@         <> ", list of {ParameterKey, ParameterValue} Objects"         <> ", or list of {Key, Value} Objects" +instance ToJSON ParametersYaml where+  toJSON = object . parametersYamlPairs+  toEncoding = pairs . mconcat . parametersYamlPairs++parametersYamlPairs :: KeyValue kv => ParametersYaml -> [kv]+parametersYamlPairs = map parameterYamlPair . unParametersYaml+ parametersYaml :: [ParameterYaml] -> ParametersYaml parametersYaml = ParametersYaml @@ -104,6 +110,14 @@   }   deriving stock (Eq, Show) +instance FromJSON ParameterYaml where+  parseJSON = withObject "Parameter" $ \o ->+    (mkParameterYaml <$> o .: "Name" <*> o .:? "Value")+      <|> (mkParameterYaml <$> o .: "ParameterKey" <*> o .:? "ParameterValue")++parameterYamlPair :: KeyValue kv => ParameterYaml -> kv+parameterYamlPair ParameterYaml {..} = pyKey .= pyValue+ mkParameterYaml :: Text -> Maybe ParameterValue -> ParameterYaml mkParameterYaml k = ParameterYaml (Key.fromText k) . Last @@ -117,11 +131,6 @@ unParameterYaml (ParameterYaml k v) =   makeParameter (Key.toText k) $ unParameterValue <$> getLast v -instance FromJSON ParameterYaml where-  parseJSON = withObject "Parameter" $ \o ->-    (mkParameterYaml <$> o .: "Name" <*> o .:? "Value")-      <|> (mkParameterYaml <$> o .: "ParameterKey" <*> o .:? "ParameterValue")- newtype ParameterValue = ParameterValue   { unParameterValue :: Text   }@@ -134,18 +143,10 @@     Number x -> pure $ ParameterValue $ dropSuffix ".0" $ pack $ show x     x -> fail $ "Expected String or Number, got: " <> show x -instance ToJSON ParameterYaml where-  toJSON = object . parameterPairs-  toEncoding = pairs . mconcat . parameterPairs--parameterPairs :: KeyValue a => ParameterYaml -> [a]-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 =@@ -172,6 +173,13 @@     v -> typeMismatch err v     where err = "Object or list of {Key, Value} Objects" +instance ToJSON TagsYaml where+  toJSON = object . tagsYamlPairs+  toEncoding = pairs . mconcat . tagsYamlPairs++tagsYamlPairs :: KeyValue kv => TagsYaml -> [kv]+tagsYamlPairs = map tagYamlPair . unTagsYaml+ tagsYaml :: [TagYaml] -> TagsYaml tagsYaml = TagsYaml @@ -185,12 +193,8 @@     t <- newTag <$> o .: "Key" <*> o .: "Value"     pure $ TagYaml t -instance ToJSON TagYaml where-  toJSON = object . tagPairs-  toEncoding = pairs . mconcat . tagPairs--tagPairs :: KeyValue a => TagYaml -> [a]-tagPairs (TagYaml t) = ["Key" .= (t ^. tag_key), "Value" .= (t ^. tag_value)]+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

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            stackctl-version:         1.1.3.0+version:         1.1.3.1 license:         MIT license-file:    LICENSE copyright:       2022 Renaissance Learning Inc@@ -172,6 +172,7 @@      build-depends:         QuickCheck,+        aeson,         base >=4 && <5,         bytestring,         hspec,

@@ -88,9 +88,22 @@       map specName (filterStackSpecs option specs)         `shouldMatchList` ["some-name", "prefix-foo"] +  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"+        specs =+          [ toSpec "some-name" "stack.yaml" Nothing+          , toSpec "other-path" "other-stack.yaml" $ Just "x"+          ]++      map specName (filterStackSpecs option specs)+        `shouldMatchList` ["some-name"]+ toSpec :: Text -> FilePath -> Maybe FilePath -> StackSpec toSpec name path mTemplate = flip runReader emptyConfig-  $ buildStackSpec "." specPath specBody+  $ buildStackSpec ".platform/specs" specPath specBody  where   stackName = StackName name   specPath = stackSpecPath scope stackName path

@@ -6,13 +6,33 @@  import Stackctl.Prelude +import Data.Aeson import qualified Data.Yaml as Yaml+import Stackctl.Action import Stackctl.AWS import Stackctl.StackSpecYaml import Test.Hspec  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"]+          }++      eitherDecode (encode yaml) `shouldBe` Right yaml+   describe "decoding Yaml" $ do     it "reads String parameters" $ do       StackSpecYaml {..} <- Yaml.decodeThrow $ mconcat