packages feed

stackctl 1.1.2.1 → 1.1.2.2

raw patch · 10 files changed

+129/−13 lines, 10 files

Files

CHANGELOG.md view
@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.2.1...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.1.2.2...main)++## [v1.1.2.2](https://github.com/freckle/stackctl/compare/v1.1.2.1...v1.1.2.2)++- Add support for Stack descriptions  ## [v1.1.2.1](https://github.com/freckle/stackctl/compare/v1.1.2.0...v1.1.2.1) 
src/Stackctl/AWS/CloudFormation.hs view
@@ -1,10 +1,10 @@ module Stackctl.AWS.CloudFormation-  (-  -- * Stacks-    Stack(..)+  ( Stack(..)+  , stackDescription   , stackIsRollbackComplete   , StackId(..)   , StackName(..)+  , StackDescription(..)   , StackEvent(..)   , ResourceStatus(..)   , stackEvent_eventId@@ -95,8 +95,12 @@ import qualified Data.UUID.V4 as UUID import Stackctl.AWS.Core import Stackctl.Sort+import Stackctl.StackDescription import UnliftIO.Exception.Lens (handling_, trying) +stackDescription :: Stack -> Maybe StackDescription+stackDescription = fmap StackDescription . (^. stack_description)+ newtype StackId = StackId   { unStackId :: Text   }@@ -328,17 +332,19 @@      , HasAwsEnv env      )   => StackName+  -> Maybe StackDescription   -> StackTemplate   -> [Parameter]   -> [Capability]   -> [Tag]   -> m (Either Text (Maybe ChangeSet))-awsCloudFormationCreateChangeSet stackName stackTemplate parameters capabilities tags+awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate parameters capabilities tags   = fmap (first formatServiceError)     $ trying (_ServiceError . hasStatus 400)     $ do         name <- newChangeSetName-        templateBody <- readFileUtf8 $ unStackTemplate stackTemplate+        templateBody <- addStackDescription mStackDescription+          <$> readFileUtf8 (unStackTemplate stackTemplate)          mStack <- awsCloudFormationDescribeStackMaybe stackName         let
src/Stackctl/Spec/Capture.hs view
@@ -85,6 +85,7 @@     , gTemplateFormat = scoTemplateFormat     , gStackPath = scoStackPath     , gStackName = scoStackName+    , gDescription = stackDescription stack     , gDepends = scoDepends     , gActions = Nothing     , gParameters = parameters stack
src/Stackctl/Spec/Generate.hs view
@@ -6,9 +6,9 @@  import Stackctl.Prelude +import Stackctl.Action import Stackctl.AWS import Stackctl.AWS.Scope-import Stackctl.Action import Stackctl.Spec.Discover (buildSpecPath) import Stackctl.StackSpec import Stackctl.StackSpecPath@@ -23,6 +23,7 @@   , gStackPath :: Maybe FilePath   -- ^ If not given, will use @{stack-name}.yaml@   , gStackName :: StackName+  , gDescription :: Maybe StackDescription   , gDepends :: Maybe [StackName]   , gActions :: Maybe [Action]   , gParameters :: Maybe [Parameter]@@ -59,7 +60,8 @@   let     templatePath = fromMaybe defaultTemplatePath gTemplatePath     specYaml = StackSpecYaml-      { ssyTemplate = templatePath+      { ssyDescription = gDescription+      , ssyTemplate = templatePath       , ssyDepends = gDepends       , ssyActions = gActions       , ssyParameters = map ParameterYaml <$> gParameters
+ src/Stackctl/StackDescription.hs view
@@ -0,0 +1,52 @@+module Stackctl.StackDescription+  ( StackDescription(..)+  , addStackDescription+  ) where++import Stackctl.Prelude++import Control.Lens ((?~))+import Data.Aeson (FromJSON, Value(..))+import qualified Data.Aeson as JSON+import Data.Aeson.Lens+import Data.ByteString.Char8 as BS8+import qualified Data.Yaml as Yaml++newtype StackDescription = StackDescription+  { unStackDescription :: Text+  }+  deriving newtype (Eq, Ord, Show, FromJSON, ToJSON)++data BodyContent+  = BodyContentJSON Value+  | BodyContentYaml Value++addStackDescription :: Maybe StackDescription -> Text -> Text+addStackDescription mStackDescription body = fromMaybe body $ do+  StackDescription d <- mStackDescription+  bc <- getBodyContent bs+  decodeUtf8 <$> case bc of+    BodyContentJSON v -> updateJSON d bs <$ guard (not $ hasDescription v)+    BodyContentYaml v -> updateYaml d bs <$ guard (not $ hasDescription v)+  where bs = encodeUtf8 body++getBodyContent :: ByteString -> Maybe BodyContent+getBodyContent body = asum+  [ BodyContentJSON . Object <$> JSON.decodeStrict body+  , hush $ BodyContentYaml . Object <$> Yaml.decodeEither' body+  ]++-- Inserting a key is easy to do in Yaml without the parsing round-trip that+-- would strip formatting and comments. But updating a key is hard. To avoid+-- this, we just say that we never clobber existing keys.+hasDescription :: Value -> Bool+hasDescription = isJust . (^? key "Description" . _String)++-- For JSON, don't worry about preserving formatting; do a proper update.+updateJSON :: Text -> ByteString -> ByteString+updateJSON d = atKey "Description" ?~ String d++-- For Yaml, insert textually to avoid a round-trip dropping comments or+-- changing whitespace. We rely on 'Show' as a naive escape.+updateYaml :: Text -> ByteString -> ByteString+updateYaml d bs = "Description: " <> BS8.pack (show d) <> "\n" <> bs
src/Stackctl/StackSpec.hs view
@@ -3,6 +3,7 @@   , stackSpecSpecPath   , stackSpecSpecBody   , stackSpecStackName+  , stackSpecStackDescription   , stackSpecActions   , stackSpecParameters   , stackSpecCapabilities@@ -23,8 +24,8 @@ import qualified Data.ByteString.Lazy as BSL import Data.List.Extra (nubOrdOn) import qualified Data.Yaml as Yaml-import Stackctl.AWS import Stackctl.Action+import Stackctl.AWS import Stackctl.Sort import Stackctl.StackSpecPath import Stackctl.StackSpecYaml@@ -46,6 +47,9 @@ stackSpecStackName :: StackSpec -> StackName stackSpecStackName = stackSpecPathStackName . ssSpecPath +stackSpecStackDescription :: StackSpec -> Maybe StackDescription+stackSpecStackDescription = ssyDescription . ssSpecBody+ stackSpecDepends :: StackSpec -> [StackName] stackSpecDepends = fromMaybe [] . ssyDepends . ssSpecBody @@ -143,6 +147,7 @@   -> m (Either Text (Maybe ChangeSet)) createChangeSet spec parameters = awsCloudFormationCreateChangeSet   (stackSpecStackName spec)+  (stackSpecStackDescription spec)   (stackSpecTemplateFile spec)   (nubOrdOn (^. parameter_parameterKey) $ parameters <> stackSpecParameters spec   )
src/Stackctl/StackSpecYaml.hs view
@@ -29,11 +29,12 @@ import Data.Aeson import Data.Aeson.Casing import qualified Data.Text as T-import Stackctl.AWS import Stackctl.Action+import Stackctl.AWS  data StackSpecYaml = StackSpecYaml-  { ssyTemplate :: FilePath+  { ssyDescription :: Maybe StackDescription+  , ssyTemplate :: FilePath   , ssyDepends :: Maybe [StackName]   , ssyActions :: Maybe [Action]   , ssyParameters :: Maybe [ParameterYaml]
stackctl.cabal view
@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            stackctl-version:         1.1.2.1+version:         1.1.2.2 license:         MIT license-file:    LICENSE copyright:       2022 Renaissance Learning Inc@@ -47,6 +47,7 @@         Stackctl.Spec.Deploy         Stackctl.Spec.Discover         Stackctl.Spec.Generate+        Stackctl.StackDescription         Stackctl.StackSpec         Stackctl.StackSpecPath         Stackctl.StackSpecYaml@@ -142,6 +143,7 @@     other-modules:         Stackctl.AWS.CloudFormationSpec         Stackctl.FilterOptionSpec+        Stackctl.StackDescriptionSpec         Stackctl.StackSpecSpec         Stackctl.StackSpecYamlSpec         Paths_stackctl
+ test/Stackctl/StackDescriptionSpec.hs view
@@ -0,0 +1,42 @@+module Stackctl.StackDescriptionSpec+  ( spec+  ) where++import Stackctl.Prelude++import Stackctl.StackDescription+import Test.Hspec++spec :: Spec+spec = do+  describe "addStackDescription" $ do+    let aDescription = Just $ StackDescription "A \"cool\" description"++    it "does nothing with nothing" $ do+      addStackDescription Nothing "hi there" `shouldBe` "hi there"++    it "does nothing invalid inputs" $ do+      for_ ["", "hi there", "[a list]", "{\"invalid\":", "true", "42"]+        $ \input -> addStackDescription aDescription input `shouldBe` input++    context "Yaml" $ do+      it "adds a Description" $ do+        addStackDescription aDescription "Resources: []\n"+          `shouldBe` "Description: \"A \\\"cool\\\" description\"\nResources: []\n"++      it "does not clobber or duplicate an existing Description" $ do+        addStackDescription+            aDescription+            "Resources: []\nDescription: Existing description\n"+          `shouldBe` "Resources: []\nDescription: Existing description\n"++    context "JSON" $ do+      it "adds a Description" $ do+        addStackDescription aDescription "{\"Resources\":[]}"+          `shouldBe` "{\"Description\":\"A \\\"cool\\\" description\",\"Resources\":[]}"++      it "does not clobber or duplicate an existing Description" $ do+        addStackDescription+            aDescription+            "{\"Resources\":[],\"Description\":\"Existing description\"}"+          `shouldBe` "{\"Resources\":[],\"Description\":\"Existing description\"}"
test/Stackctl/StackSpecSpec.hs view
@@ -32,7 +32,8 @@   stackName = StackName name   specPath = stackSpecPath scope stackName "a/b.yaml"   specBody = StackSpecYaml-    { ssyDepends = Just $ map StackName depends+    { ssyDescription = Nothing+    , ssyDepends = Just $ map StackName depends     , ssyActions = Nothing     , ssyTemplate = ""     , ssyParameters = Nothing