stackctl 1.4.4.0 → 1.5.0.0
raw patch · 15 files changed
+379/−99 lines, 15 filesdep +hspec-golden
Dependencies added: hspec-golden
Files
- CHANGELOG.md +19/−1
- src/Stackctl/AWS/CloudFormation.hs +26/−20
- src/Stackctl/AWS/Core.hs +12/−7
- src/Stackctl/AWS/EC2.hs +1/−1
- src/Stackctl/AWS/Orphans.hs +31/−40
- src/Stackctl/AWS/STS.hs +1/−1
- src/Stackctl/Action.hs +44/−6
- src/Stackctl/FilterOption.hs +1/−1
- src/Stackctl/OneOrListOf.hs +56/−0
- src/Stackctl/Spec/Changes/Format.hs +1/−0
- src/Stackctl/Spec/List.hs +69/−8
- stackctl.cabal +22/−13
- test/Stackctl/OneOrListOfSpec.hs +47/−0
- test/Stackctl/Spec/Changes/FormatSpec.hs +48/−0
- test/Stackctl/StackSpecYamlSpec.hs +1/−1
CHANGELOG.md view
@@ -1,4 +1,22 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.4.4.0...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.5.0.0...main)++## [v1.5.0.0](https://github.com/freckle/stackctl/compare/v1.4.4.0...v1.5.0.0)++Breaking changes:++- Don't require a name argument to the `awsSimple` function++New features:++- Add `Exec` and `Shell` features in `actions[].run`+- Support lists in `actions[].run` (single items still work)+- Add more granular status indicators in `stack-ls(1)` output, print a legend of+ these indicators as a footer (disable with `--no-legend`)++Fixes:++- Fix for redundant change-set creation errors in logging output+- Fix globbing bug in auto-expansion of `--filter` arguments ## [v1.4.4.0](https://github.com/freckle/stackctl/compare/v1.4.3.0...v1.4.4.0)
src/Stackctl/AWS/CloudFormation.hs view
@@ -1,6 +1,7 @@ module Stackctl.AWS.CloudFormation ( Stack (..) , stack_stackName+ , stack_stackStatus , stackDescription , stackStatusRequiresDeletion , StackId (..)@@ -45,6 +46,7 @@ -- * ChangeSets , ChangeSet (..)+ , changeSetFromResponse , changeSetJSON , ChangeSetId (..) , ChangeSetName (..)@@ -174,7 +176,7 @@ awsCloudFormationDescribeStack stackName = do let req = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName - awsSimple "DescribeStack" req $ \resp -> do+ awsSimple req $ \resp -> do stacks <- resp ^. describeStacksResponse_stacks listToMaybe stacks @@ -250,7 +252,7 @@ [] -> Nothing (e : _) -> Just $ e ^. stackEvent_eventId - awsSimple "DescribeStackEvents" req+ awsSimple req $ pure . getFirstEventId . fromMaybe []@@ -266,7 +268,7 @@ describeReq = newDescribeStacks & describeStacks_stackName ?~ unStackName stackName - awsSimple "DeleteStack" deleteReq $ const $ pure ()+ awsSimple deleteReq $ const $ pure () logDebug "Awaiting DeleteStack" stackDeleteResult <$> awsAwait newStackDeleteComplete describeReq@@ -296,7 +298,7 @@ decodeTemplateBody body = fromMaybe (toJSON body) $ decodeStrict $ encodeUtf8 body - awsSimple "GetTemplate" req $ \resp -> do+ awsSimple req $ \resp -> do body <- resp ^. getTemplateResponse_templateBody pure $ decodeTemplateBody body @@ -339,6 +341,23 @@ , csResponse :: DescribeChangeSetResponse } +changeSetFromResponse :: DescribeChangeSetResponse -> Maybe ChangeSet+changeSetFromResponse resp =+ ChangeSet+ <$> (resp ^. describeChangeSetResponse_creationTime)+ <*> pure (fmap sortChanges $ resp ^. describeChangeSetResponse_changes)+ <*> (ChangeSetName <$> resp ^. describeChangeSetResponse_changeSetName)+ <*> (resp ^. describeChangeSetResponse_executionStatus)+ <*> (ChangeSetId <$> resp ^. describeChangeSetResponse_changeSetId)+ <*> pure (resp ^. describeChangeSetResponse_parameters)+ <*> (StackId <$> resp ^. describeChangeSetResponse_stackId)+ <*> pure (resp ^. describeChangeSetResponse_capabilities)+ <*> pure (resp ^. describeChangeSetResponse_tags)+ <*> (StackName <$> resp ^. describeChangeSetResponse_stackName)+ <*> pure (resp ^. describeChangeSetResponse_status)+ <*> pure (resp ^. describeChangeSetResponse_statusReason)+ <*> pure resp+ changeSetJSON :: ChangeSet -> Text changeSetJSON = decodeUtf8 . BSL.toStrict . encodePretty . csResponse @@ -362,6 +381,7 @@ awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate parameters capabilities tags = fmap (first formatServiceError) $ trying (_ServiceError . hasStatus 400)+ $ awsSilently $ do name <- newChangeSetName @@ -390,7 +410,7 @@ logInfo $ "Creating changeset..." :# ["name" .= name, "type" .= changeSetType]- csId <- awsSimple "CreateChangeSet" req (^. createChangeSetResponse_id)+ csId <- awsSimple req (^. createChangeSetResponse_id) logDebug "Awaiting CREATE_COMPLETE" void $ awsAwait newChangeSetCreateComplete $ newDescribeChangeSet csId@@ -405,21 +425,7 @@ -> m ChangeSet awsCloudFormationDescribeChangeSet changeSetId = do let req = newDescribeChangeSet $ unChangeSetId changeSetId- awsSimple "DescribeChangeSet" req $ \resp ->- ChangeSet- <$> (resp ^. describeChangeSetResponse_creationTime)- <*> pure (fmap sortChanges $ resp ^. describeChangeSetResponse_changes)- <*> (ChangeSetName <$> resp ^. describeChangeSetResponse_changeSetName)- <*> (resp ^. describeChangeSetResponse_executionStatus)- <*> (ChangeSetId <$> resp ^. describeChangeSetResponse_changeSetId)- <*> pure (resp ^. describeChangeSetResponse_parameters)- <*> (StackId <$> resp ^. describeChangeSetResponse_stackId)- <*> pure (resp ^. describeChangeSetResponse_capabilities)- <*> pure (resp ^. describeChangeSetResponse_tags)- <*> (StackName <$> resp ^. describeChangeSetResponse_stackName)- <*> pure (resp ^. describeChangeSetResponse_status)- <*> pure (resp ^. describeChangeSetResponse_statusReason)- <*> pure resp+ awsSimple req changeSetFromResponse sortChanges :: [Change] -> [Change] sortChanges = sortByDependencies changeName changeCausedBy
src/Stackctl/AWS/Core.hs view
@@ -39,6 +39,7 @@ import Conduit (ConduitM) import Control.Monad.Logger (defaultLoc, toLogStr) import Control.Monad.Trans.Resource (MonadResource)+import Data.Typeable (typeRep) import Stackctl.AWS.Orphans () import UnliftIO.Exception.Lens (handling) @@ -84,22 +85,26 @@ withAuth auth f awsSimple- :: ( MonadResource m+ :: forall a env m b+ . ( HasCallStack+ , MonadResource m , MonadReader env m , HasAwsEnv env , AWSRequest a , Typeable a , Typeable (AWSResponse a) )- => Text- -> a+ => a -> (AWSResponse a -> Maybe b) -> m b-awsSimple name req post = do+awsSimple req post = do resp <- awsSend req++ let+ name = show $ typeRep $ Proxy @a+ err = name <> " successful, but processing the response failed"+ maybe (throwString err) pure $ post resp- where- err = unpack name <> " successful, but processing the response failed" awsSend :: ( MonadResource m@@ -158,7 +163,7 @@ awsAssumeRole role sessionName f = do let req = newAssumeRole role sessionName - assumeEnv <- awsSimple "sts:AssumeRole" req $ \resp -> do+ assumeEnv <- awsSimple req $ \resp -> do let creds = resp ^. assumeRoleResponse_credentials token <- creds ^. authEnv_sessionToken
src/Stackctl/AWS/EC2.hs view
@@ -12,7 +12,7 @@ :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m Region awsEc2DescribeFirstAvailabilityZoneRegionName = do let req = newDescribeAvailabilityZones- awsSimple "DescribeAvailabilityZones" req $ \resp -> do+ awsSimple req $ \resp -> do azs <- resp ^. describeAvailabilityZonesResponse_availabilityZones az <- listToMaybe azs rn <- regionName az
src/Stackctl/AWS/Orphans.hs view
@@ -16,8 +16,17 @@ -- Makes it syntactally easier to do a bunch of these newtype Generically a = Generically {unGenerically :: a}+ instance ( Generic a+ , GFromJSON Zero (Rep a)+ )+ => FromJSON (Generically a)+ where+ parseJSON = fmap Generically . genericParseJSON defaultOptions++instance+ ( Generic a , GToJSON' Value Zero (Rep a) , GToJSON' Encoding Zero (Rep a) )@@ -26,43 +35,25 @@ toJSON = genericToJSON defaultOptions . unGenerically toEncoding = genericToEncoding defaultOptions . unGenerically -deriving via- (Generically DescribeChangeSetResponse)- instance- ToJSON DescribeChangeSetResponse-deriving via- (Generically Tag)- instance- ToJSON Tag-deriving via- (Generically Parameter)- instance- ToJSON Parameter-deriving via- (Generically RollbackConfiguration)- instance- ToJSON RollbackConfiguration-deriving via- (Generically RollbackTrigger)- instance- ToJSON RollbackTrigger-deriving via- (Generically Change)- instance- ToJSON Change-deriving via- (Generically ResourceChange)- instance- ToJSON ResourceChange-deriving via- (Generically ModuleInfo)- instance- ToJSON ModuleInfo-deriving via- (Generically ResourceChangeDetail)- instance- ToJSON ResourceChangeDetail-deriving via- (Generically ResourceTargetDefinition)- instance- ToJSON ResourceTargetDefinition+{- FOURMOLU_DISABLE -}++deriving via (Generically Change) instance FromJSON Change+deriving via (Generically Change) instance ToJSON Change+deriving via (Generically DescribeChangeSetResponse) instance FromJSON DescribeChangeSetResponse+deriving via (Generically DescribeChangeSetResponse) instance ToJSON DescribeChangeSetResponse+deriving via (Generically ModuleInfo) instance FromJSON ModuleInfo+deriving via (Generically ModuleInfo) instance ToJSON ModuleInfo+deriving via (Generically Parameter) instance FromJSON Parameter+deriving via (Generically Parameter) instance ToJSON Parameter+deriving via (Generically ResourceChange) instance FromJSON ResourceChange+deriving via (Generically ResourceChange) instance ToJSON ResourceChange+deriving via (Generically ResourceChangeDetail) instance FromJSON ResourceChangeDetail+deriving via (Generically ResourceChangeDetail) instance ToJSON ResourceChangeDetail+deriving via (Generically ResourceTargetDefinition) instance FromJSON ResourceTargetDefinition+deriving via (Generically ResourceTargetDefinition) instance ToJSON ResourceTargetDefinition+deriving via (Generically RollbackConfiguration) instance FromJSON RollbackConfiguration+deriving via (Generically RollbackConfiguration) instance ToJSON RollbackConfiguration+deriving via (Generically RollbackTrigger) instance FromJSON RollbackTrigger+deriving via (Generically RollbackTrigger) instance ToJSON RollbackTrigger+deriving via (Generically Tag) instance FromJSON Tag+deriving via (Generically Tag) instance ToJSON Tag
src/Stackctl/AWS/STS.hs view
@@ -10,5 +10,5 @@ awsGetCallerIdentityAccount :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m AccountId awsGetCallerIdentityAccount = do- awsSimple "GetCallerIdentity" newGetCallerIdentity $ \resp -> do+ awsSimple newGetCallerIdentity $ \resp -> do AccountId <$> resp ^. getCallerIdentityResponse_account
src/Stackctl/Action.hs view
@@ -21,20 +21,25 @@ import Stackctl.Prelude hiding (on) +import Blammo.Logging.Logger (flushLogger) import Data.Aeson import Data.List (find)+import qualified Data.List.NonEmpty as NE import Stackctl.AWS import Stackctl.AWS.Lambda+import Stackctl.OneOrListOf+import qualified Stackctl.OneOrListOf as OneOrListOf+import System.Process.Typed data Action = Action { on :: ActionOn- , run :: ActionRun+ , run :: OneOrListOf ActionRun } deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON) -newAction :: ActionOn -> ActionRun -> Action-newAction = Action+newAction :: ActionOn -> [ActionRun] -> Action+newAction on runs = Action {on, run = OneOrListOf.fromList runs} data ActionOn = PostDeploy deriving stock (Eq, Show, Generic)@@ -54,31 +59,45 @@ data ActionRun = InvokeLambdaByStackOutput Text | InvokeLambdaByName Text+ | Exec (NonEmpty String)+ | Shell String deriving stock (Eq, Show) instance FromJSON ActionRun where parseJSON = withObject "ActionRun" $ \o -> (InvokeLambdaByStackOutput <$> o .: "InvokeLambdaByStackOutput") <|> (InvokeLambdaByName <$> o .: "InvokeLambdaByName")+ <|> (Exec <$> o .: "Exec")+ <|> (Shell <$> o .: "Shell") instance ToJSON ActionRun where toJSON = object . \case InvokeLambdaByStackOutput name -> ["InvokeLambdaByStackOutput" .= name] InvokeLambdaByName name -> ["InvokeLambdaByName" .= name]+ Exec args -> ["Exec" .= args]+ Shell arg -> ["Shell" .= arg] toEncoding = pairs . \case InvokeLambdaByStackOutput name -> "InvokeLambdaByStackOutput" .= name InvokeLambdaByName name -> "InvokeLambdaByName" .= name+ Exec args -> "Exec" .= args+ Shell arg -> "Shell" .= arg data ActionFailure = NoSuchOutput | InvokeLambdaFailure+ | ExecFailure ExitCode deriving stock (Show) deriving anyclass (Exception) runActions- :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+ :: ( MonadResource m+ , MonadLogger m+ , MonadReader env m+ , HasLogger env+ , HasAwsEnv env+ ) => StackName -> ActionOn -> [Action]@@ -90,14 +109,19 @@ shouldRunOn Action {on} on' = on == on' runAction- :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)+ :: ( MonadResource m+ , MonadLogger m+ , MonadReader env m+ , HasLogger env+ , HasAwsEnv env+ ) => StackName -> Action -> m () runAction stackName Action {on, run} = do logInfo $ "Running action" :# ["on" .= on, "run" .= run] - case run of+ for_ run $ \case InvokeLambdaByStackOutput outputName -> do outputs <- awsCloudFormationDescribeStackOutputs stackName case findOutputValue outputName outputs of@@ -111,6 +135,8 @@ throwIO NoSuchOutput Just name -> invoke name InvokeLambdaByName name -> invoke name+ Exec args -> execProcessAction (NE.head args) (NE.tail args)+ Shell arg -> execProcessAction "sh" ["-c", arg] where invoke name = do result <- awsLambdaInvoke name payload@@ -122,3 +148,15 @@ findOutputValue :: Text -> [Output] -> Maybe Text findOutputValue name = view output_outputValue <=< find ((== Just name) . view output_outputKey)++execProcessAction+ :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env)+ => String+ -> [String]+ -> m ()+execProcessAction cmd args = do+ logDebug $ "runProcess" :# ["command" .= (cmd : args)]+ flushLogger++ ec <- runProcess $ proc cmd args+ unless (ec == ExitSuccess) $ throwIO $ ExecFailure ec
src/Stackctl/FilterOption.hs view
@@ -77,7 +77,7 @@ suffixed | "*" `T.isSuffixOf` t || hasExtension s = []- | otherwise = (s </> "*") : map (s <.>) extensions+ | otherwise = (s </> "**" </> "*") : map (s <.>) extensions extensions = ["json", "yaml"]
+ src/Stackctl/OneOrListOf.hs view
@@ -0,0 +1,56 @@+module Stackctl.OneOrListOf+ ( OneOrListOf+ , fromList+ ) where++import Stackctl.Prelude++import Data.Aeson++-- | Type representing one @a@ or a list of @a@+--+-- This type is isomorphic both @'NonEmpty' a@ and @'Either' a [a]@. Its primary+-- use-case is to parse Yaml (through its 'FromJSON') where users may specify a+-- list of values, but specifying a single value is worth supporting, typically+-- for backwards-compatibility:+--+-- @+-- something:+-- field:+-- - one+-- - two+--+-- something:+-- field: one # => should be treated like field: [one]+-- @+--+-- The 'Foldable' instance should be used to treat the value like a list, such+-- as extracting it directly via 'toList'.+--+-- Implementation note: this type preserves the form in which it was decoded (in+-- other words, it's not a @newtype@ over one of the isomorphic types mentioned+-- above), so that we can encode it back out in the same format.+data OneOrListOf a = One a | List [a]+ deriving stock (Eq, Show, Generic, Foldable)++fromList :: [a] -> OneOrListOf a+fromList = List++instance Semigroup (OneOrListOf a) where+ One a <> One b = List [a, b]+ One a <> List bs = List $ a : bs+ List as <> One b = List $ as <> [b]+ List as <> List bs = List $ as <> bs++instance FromJSON a => FromJSON (OneOrListOf a) where+ parseJSON = \case+ Array xs -> List . toList <$> traverse parseJSON xs+ v -> One <$> parseJSON v++instance ToJSON a => ToJSON (OneOrListOf a) where+ toJSON = \case+ One a -> toJSON a+ List as -> toJSON as+ toEncoding = \case+ One a -> toEncoding a+ List as -> toEncoding as
src/Stackctl/Spec/Changes/Format.hs view
@@ -19,6 +19,7 @@ data Format = FormatTTY | FormatPullRequest+ deriving stock (Bounded, Enum, Show) data OmitFull = OmitFull
src/Stackctl/Spec/List.hs view
@@ -7,6 +7,7 @@ import Stackctl.Prelude import Blammo.Logging.Logger (pushLoggerLn)+import qualified Data.Text as T import Options.Applicative import Stackctl.AWS import Stackctl.AWS.Scope@@ -17,12 +18,21 @@ import Stackctl.Spec.Discover import Stackctl.StackSpec -data ListOptions = ListOptions---- brittany-disable-next-binding+newtype ListOptions = ListOptions+ { loLegend :: Bool+ } parseListOptions :: Parser ListOptions-parseListOptions = pure ListOptions+parseListOptions =+ ListOptions+ <$> ( not+ <$> switch+ ( mconcat+ [ long "no-legend"+ , help "Don't print indicators legend at the end"+ ]+ )+ ) runList :: ( MonadUnliftIO m@@ -39,23 +49,74 @@ ) => ListOptions -> m ()-runList _ = do- Colors {..} <- getColorsLogger+runList ListOptions {..} = do+ colors@Colors {..} <- getColorsLogger forEachSpec_ $ \spec -> do let path = stackSpecFilePath spec name = stackSpecStackName spec - exists <- isJust <$> awsCloudFormationDescribeStackMaybe name+ mStackStatus <-+ fmap (^. stack_stackStatus)+ <$> awsCloudFormationDescribeStackMaybe name let+ indicator = maybe NotDeployed statusIndicator mStackStatus+ formatted :: Text formatted = " "- <> (if exists then green "✓ " else yellow "✗ ")+ <> indicatorIcon colors indicator+ <> " " <> cyan (unStackName name) <> " => " <> magenta (pack path) pushLoggerLn formatted++ let legendItem i = indicatorIcon colors i <> " " <> indicatorDescription i++ when loLegend+ $ pushLoggerLn+ $ "\nLegend:\n "+ <> T.intercalate ", " (map legendItem [minBound .. maxBound])++data Indicator+ = Deployed+ | DeployFailed+ | NotDeployed+ | Reviewing+ | Deploying+ | Unknown+ deriving stock (Bounded, Enum)++indicatorIcon :: Colors -> Indicator -> Text+indicatorIcon Colors {..} = \case+ Deployed -> green "✓"+ DeployFailed -> red "✗"+ NotDeployed -> yellow "_"+ Reviewing -> yellow "∇"+ Deploying -> cyan "⋅"+ Unknown -> magenta "?"++indicatorDescription :: Indicator -> Text+indicatorDescription = \case+ Deployed -> "deployed"+ DeployFailed -> "failed or rolled back"+ NotDeployed -> "doesn't exist"+ Reviewing -> "reviewing"+ Deploying -> "deploying"+ Unknown -> "unknown"++statusIndicator :: StackStatus -> Indicator+statusIndicator = \case+ StackStatus_REVIEW_IN_PROGRESS -> Reviewing+ StackStatus_ROLLBACK_COMPLETE -> DeployFailed+ x | statusSuffixed "_IN_PROGRESS" x -> Deploying+ x | statusSuffixed "_FAILED" x -> DeployFailed+ x | statusSuffixed "_ROLLBACK_COMPLETE" x -> DeployFailed+ x | statusSuffixed "_COMPLETE" x -> Deployed+ _ -> Unknown+ where+ statusSuffixed x = (x `T.isSuffixOf`) . fromStackStatus
stackctl.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: stackctl-version: 1.4.4.0+version: 1.5.0.0 license: MIT license-file: LICENSE copyright: 2022 Renaissance Learning Inc@@ -38,6 +38,7 @@ Stackctl.Config.RequiredVersion Stackctl.DirectoryOption Stackctl.FilterOption+ Stackctl.OneOrListOf Stackctl.Options Stackctl.ParameterOption Stackctl.Prelude@@ -75,10 +76,11 @@ ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything- -Wno-all-missed-specialisations -Wno-missing-import-lists- -Wno-missing-kind-signatures -Wno-missing-local-signatures- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module- -Wno-unsafe -optP-Wno-nonportable-include-path+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module -Wno-unsafe+ -optP-Wno-nonportable-include-path build-depends: Blammo >=1.1.2.1,@@ -137,10 +139,11 @@ ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything- -Wno-all-missed-specialisations -Wno-missing-import-lists- -Wno-missing-kind-signatures -Wno-missing-local-signatures- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module- -Wno-unsafe -optP-Wno-nonportable-include-path -threaded -rtsopts+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module -Wno-unsafe+ -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N build-depends:@@ -157,6 +160,8 @@ Stackctl.Config.RequiredVersionSpec Stackctl.ConfigSpec Stackctl.FilterOptionSpec+ Stackctl.OneOrListOfSpec+ Stackctl.Spec.Changes.FormatSpec Stackctl.StackDescriptionSpec Stackctl.StackSpecSpec Stackctl.StackSpecYamlSpec@@ -174,17 +179,21 @@ ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything- -Wno-all-missed-specialisations -Wno-missing-import-lists- -Wno-missing-kind-signatures -Wno-missing-local-signatures- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module- -Wno-unsafe -optP-Wno-nonportable-include-path+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module -Wno-unsafe+ -optP-Wno-nonportable-include-path build-depends:+ Glob, QuickCheck, aeson, base >=4 && <5, bytestring,+ filepath, hspec,+ hspec-golden >=0.2.1.0, mtl, stackctl, yaml
+ test/Stackctl/OneOrListOfSpec.hs view
@@ -0,0 +1,47 @@+module Stackctl.OneOrListOfSpec+ ( spec+ ) where++import Stackctl.Prelude++import Data.Aeson+import qualified Data.Yaml as Yaml+import Stackctl.OneOrListOf+import Test.Hspec++data ExampleObject = ExampleObject+ { oneOf :: OneOrListOf Text+ , listOf :: OneOrListOf Text+ }+ deriving stock (Generic)+ deriving anyclass (FromJSON, ToJSON)++-- N.B. the sorting and indentation must match what encode will do in order for+-- the round-trip spec to pass.+exampleBS :: ByteString+exampleBS =+ mconcat+ [ "listOf:\n"+ , "- one\n"+ , "- two\n"+ , "oneOf: one\n"+ ]++spec :: Spec+spec = do+ it "Foldable" $ do+ ExampleObject {..} <- Yaml.decodeThrow exampleBS++ toList oneOf `shouldBe` ["one"]++ toList listOf `shouldBe` ["one", "two"]++ it "Semigroup" $ do+ ExampleObject {..} <- Yaml.decodeThrow exampleBS++ toList (oneOf <> listOf) `shouldBe` ["one", "one", "two"]++ it "From/ToJSON" $ do+ decoded <- Yaml.decodeThrow @_ @ExampleObject exampleBS++ Yaml.encode decoded `shouldBe` exampleBS
+ test/Stackctl/Spec/Changes/FormatSpec.hs view
@@ -0,0 +1,48 @@+module Stackctl.Spec.Changes.FormatSpec+ ( spec+ )+where++import Stackctl.Prelude++import Data.Aeson+import Stackctl.AWS.CloudFormation (changeSetFromResponse)+import Stackctl.Colors+import Stackctl.Spec.Changes.Format+import System.FilePath ((-<.>))+import System.FilePath.Glob (globDir1)+import Test.Hspec+import Test.Hspec.Golden++spec :: Spec+spec = do+ describe "formatChangeSet" $ do+ paths <- runIO $ globDir1 "**/*.json" "test/files/change-sets"++ for_ paths $ \path -> do+ for_ [minBound .. maxBound] $ \fmt -> do+ it (path <> " as " <> show fmt) $ do+ formatChangeSetGolden path fmt++formatChangeSetGolden :: FilePath -> Format -> IO (Golden Text)+formatChangeSetGolden path fmt = do+ actual <-+ formatChangeSet noColors OmitFull "some-stack" fmt+ . (changeSetFromResponse <=< decodeStrict)+ . encodeUtf8+ <$> readFileUtf8 path++ pure+ $ Golden+ { output = actual+ , encodePretty = unpack+ , writeToFile = writeFileUtf8+ , readFromFile = readFileUtf8+ , goldenFile = path -<.> ext+ , actualFile = Nothing+ , failFirstTime = False+ }+ where+ ext = case fmt of+ FormatTTY -> "txt"+ FormatPullRequest -> "md"
test/Stackctl/StackSpecYamlSpec.hs view
@@ -24,7 +24,7 @@ , ssyDepends = Just [StackName "a-stack", StackName "another-stack"] , ssyActions = Just- [newAction PostDeploy $ InvokeLambdaByName "a-lambda"]+ [newAction PostDeploy [InvokeLambdaByName "a-lambda"]] , ssyParameters = Just $ parametersYaml