diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.6.1.0...main) +## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.6.1.1...main) + +## [v1.6.1.1](https://github.com/freckle/stackctl/compare/v1.6.1.0...v1.6.1.1) + +- Fix: finding removed stacks now respects `STACKCTL_DIRECTORY` ## [v1.6.1.0](https://github.com/freckle/stackctl/compare/v1.6.0.0...v1.6.1.0) diff --git a/src/Stackctl/RemovedStack.hs b/src/Stackctl/RemovedStack.hs --- a/src/Stackctl/RemovedStack.hs +++ b/src/Stackctl/RemovedStack.hs @@ -9,6 +9,7 @@ import Stackctl.AWS.CloudFormation import Stackctl.AWS.Core as AWS import Stackctl.AWS.Scope +import Stackctl.DirectoryOption import Stackctl.FilterOption import UnliftIO.Directory (doesFileExist) @@ -17,26 +18,30 @@ , MonadAWS m , MonadReader env m , HasAwsScope env + , HasDirectoryOption env , HasFilterOption env ) => m [Stack] inferRemovedStacks = do scope <- view awsScopeL paths <- view $ filterOptionL . to filterOptionToPaths - catMaybes <$> traverse (findRemovedStack scope) paths + dir <- view $ directoryOptionL . to unDirectoryOption + catMaybes <$> traverse (findRemovedStack scope dir) paths findRemovedStack :: (MonadUnliftIO m, MonadAWS m) => AwsScope -> FilePath + -- ^ Root directory + -> FilePath -> m (Maybe Stack) -findRemovedStack scope path = runMaybeT $ do +findRemovedStack scope dir path = runMaybeT $ do -- The filter is a full path to a specification in the current -- account/region... stackName <- hoistMaybe $ awsScopeSpecStackName scope path -- that no longer exists... - guard . not =<< doesFileExist path + guard . not =<< doesFileExist (dir path) -- but the Stack it would point to does MaybeT $ awsCloudFormationDescribeStackMaybe stackName 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.0 +version: 1.6.1.1 license: MIT license-file: LICENSE copyright: 2022 Renaissance Learning Inc @@ -165,6 +165,7 @@ Stackctl.ConfigSpec Stackctl.FilterOptionSpec Stackctl.OneOrListOfSpec + Stackctl.RemovedStackSpec Stackctl.Spec.Changes.FormatSpec Stackctl.StackDescriptionSpec Stackctl.StackSpecSpec @@ -195,6 +196,7 @@ Glob >=0.10.2, QuickCheck >=2.14.2, aeson >=2.0.3.0, + amazonka >=2.0, amazonka-cloudformation >=2.0, amazonka-ec2 >=2.0, amazonka-lambda >=2.0, @@ -205,7 +207,11 @@ hspec >=2.9.7, hspec-expectations-lifted >=0.10.0, hspec-golden >=0.2.1.0, + http-types >=0.12.3, lens >=5.1.1, mtl >=2.2.2, stackctl, + text >=1.2.5.0, + time >=1.11.1.1, + unliftio >=0.2.25.0, yaml >=0.11.8.0 diff --git a/test/Stackctl/RemovedStackSpec.hs b/test/Stackctl/RemovedStackSpec.hs new file mode 100644 --- /dev/null +++ b/test/Stackctl/RemovedStackSpec.hs @@ -0,0 +1,117 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Stackctl.RemovedStackSpec + ( spec + ) where + +import Stackctl.Test.App + +import qualified Amazonka +import qualified Amazonka.CloudFormation as CloudFormation +import Amazonka.CloudFormation.DescribeStacks +import Amazonka.CloudFormation.Types.Stack +import qualified Data.Text as T +import Data.Time (UTCTime (..)) +import Data.Time.Calendar (DayOfMonth, MonthOfYear, Year, fromGregorian) +import Network.HTTP.Types.Status (status400) +import Stackctl.AWS.CloudFormation +import Stackctl.DirectoryOption (DirectoryOption (..), directoryOptionL) +import Stackctl.FilterOption (filterOptionFromText, filterOptionL) +import Stackctl.RemovedStack +import UnliftIO.Directory (createDirectoryIfMissing) + +spec :: Spec +spec = do + describe "inferRemovedStacks" $ do + it "returns stacks in filters that aren't on disk" $ example $ runTestAppT $ do + let + Just filterOption = + filterOptionFromText + $ T.intercalate + "," + [ pack $ testAppStackFilePath "stack-exists" + , pack $ testAppStackFilePath "stack-is-missing" + , "stacks/0123456789.test/us-east-2/wrong-region.yaml" + , "stacks/2123456789.test/us-east-1/wrong-account.yaml" + ] + + setup :: TestApp -> TestApp + setup = filterOptionL .~ filterOption + + matchers = + [ describeStackMatcher "stack-exists" $ Just $ someStack "stack-exists" + , describeStackMatcher "stack-is-missing" Nothing + , describeStackMatcher "wrong-region" Nothing + , describeStackMatcher "wrong-account" Nothing + ] + + stacks <- local setup $ withMatchers matchers inferRemovedStacks + map (^. stack_stackName) stacks `shouldBe` ["stack-exists"] + + -- If we don't check for file existence respecting STACKCTL_DIRECTORY, then + -- any non-default value will cause all specs to appear non-existent and be + -- flagged for removal. Eek. + it "respects STACKCTL_DIRECTORY" $ example $ runTestAppT $ do + let + dir = "/tmp/stackctl-test" + toRemove = "stack-to-remove" + toKeep = "stack-to-keep" + relativeToRemove = testAppStackFilePath toRemove + relativeToKeep = testAppStackFilePath toKeep + absoluteToKeep = dir relativeToKeep + Just filterOption = + filterOptionFromText + $ pack relativeToRemove + <> "," + <> pack relativeToKeep + + setup :: TestApp -> TestApp + setup app = + app + & filterOptionL .~ filterOption + & directoryOptionL .~ DirectoryOption dir + + matchers = + [ describeStackMatcher toRemove $ Just $ someStack toRemove + , describeStackMatcher toKeep $ Just $ someStack toKeep + ] + + -- Create a spec on disk for toKeep, then we should only find toRemove + createDirectoryIfMissing True $ takeDirectory absoluteToKeep + writeFileUtf8 absoluteToKeep "{}" + + stacks <- local setup $ withMatchers matchers inferRemovedStacks + map (^. stack_stackName) stacks `shouldBe` [toRemove] + +describeStackMatcher :: Text -> Maybe Stack -> Matcher +describeStackMatcher name = + SendMatcher ((== Just name) . (^. describeStacks_stackName)) + . maybe + (Left cloudFormationValidationError) + ( \stack -> + Right + $ newDescribeStacksResponse 200 + & describeStacksResponse_stacks ?~ [stack] + ) + +someStack :: Text -> Stack +someStack name = newStack name (midnight 2024 1 1) StackStatus_CREATE_COMPLETE + +midnight :: Year -> MonthOfYear -> DayOfMonth -> UTCTime +midnight y m d = + UTCTime + { utctDay = fromGregorian y m d + , utctDayTime = 0 + } + +cloudFormationValidationError :: Amazonka.Error +cloudFormationValidationError = + Amazonka.ServiceError + $ Amazonka.ServiceError' + { Amazonka.abbrev = CloudFormation.defaultService ^. Amazonka.service_abbrev + , Amazonka.status = status400 + , Amazonka.headers = [] + , Amazonka.code = "ValidationError" + , Amazonka.message = Nothing + , Amazonka.requestId = Nothing + } diff --git a/test/Stackctl/Test/App.hs b/test/Stackctl/Test/App.hs --- a/test/Stackctl/Test/App.hs +++ b/test/Stackctl/Test/App.hs @@ -1,5 +1,8 @@ module Stackctl.Test.App - ( TestAppT + ( TestApp + , testAppAwsScope + , testAppStackFilePath + , TestAppT , runTestAppT -- * Re-exports @@ -16,12 +19,19 @@ import Control.Lens ((?~)) import Control.Monad.AWS import Control.Monad.AWS.ViaMock +import Stackctl.AWS.Core (AccountId (..)) +import Stackctl.AWS.Scope +import Stackctl.DirectoryOption +import Stackctl.FilterOption import Test.Hspec (Spec, describe, example, it) import Test.Hspec.Expectations.Lifted data TestApp = TestApp { taLogger :: Logger , taMatchers :: Matchers + , taAwsScope :: AwsScope + , taFilterOption :: FilterOption + , taDirectoryOption :: DirectoryOption } instance HasLogger TestApp where @@ -30,6 +40,15 @@ instance HasMatchers TestApp where matchersL = lens taMatchers $ \x y -> x {taMatchers = y} +instance HasAwsScope TestApp where + awsScopeL = lens taAwsScope $ \x y -> x {taAwsScope = y} + +instance HasFilterOption TestApp where + filterOptionL = lens taFilterOption $ \x y -> x {taFilterOption = y} + +instance HasDirectoryOption TestApp where + directoryOptionL = lens taDirectoryOption $ \x y -> x {taDirectoryOption = y} + newtype TestAppT m a = TestAppT { unTestAppT :: ReaderT TestApp (LoggingT m) a } @@ -53,5 +72,25 @@ TestApp <$> newTestLogger defaultLogSettings <*> pure mempty + <*> pure testAppAwsScope + <*> pure defaultFilterOption + <*> pure defaultDirectoryOption runLoggerLoggingT app $ runReaderT (unTestAppT f) app + +testAppAwsScope :: AwsScope +testAppAwsScope = + AwsScope + { awsAccountId = AccountId "0123456789" + , awsAccountName = "test" + , awsRegion = "us-east-1" + } + +-- | Gives a filepath relative to 'testAwsScope' +testAppStackFilePath :: Text -> FilePath +testAppStackFilePath base = + "stacks" + "0123456789.test" + "us-east-1" + unpack base + <.> "yaml"