packages feed

stackctl 1.6.0.0 → 1.6.1.0

raw patch · 8 files changed

+244/−11 lines, 8 filesdep +hspec-expectations-lifted

Dependencies added: hspec-expectations-lifted

Files

CHANGELOG.md view
@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.6.0.0...main)+## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.6.1.0...main)++## [v1.6.1.0](https://github.com/freckle/stackctl/compare/v1.6.0.0...v1.6.1.0)++- Add `Ord` instance on `RequiredVersion` and `RequiredVersionOp`  ## [v1.6.0.0](https://github.com/freckle/stackctl/compare/v1.5.0.1...v1.6.0.0) 
src/Stackctl/AWS/Lambda.hs view
@@ -60,7 +60,7 @@   , errorMessage :: Text   , trace :: [Text]   }-  deriving stock (Show, Generic)+  deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON)  awsLambdaInvoke
src/Stackctl/Config/RequiredVersion.hs view
@@ -24,7 +24,7 @@   { requiredVersionOp :: RequiredVersionOp   , requiredVersionCompareWith :: Version   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Ord, Show)  instance Arbitrary RequiredVersion where   arbitrary = RequiredVersion <$> arbitrary <*> arbitrary@@ -96,7 +96,7 @@   | RequiredVersionGT   | RequiredVersionGTE   | RequiredVersionIsh-  deriving stock (Eq, Show, Bounded, Enum)+  deriving stock (Eq, Ord, Show, Bounded, Enum)  instance Arbitrary RequiredVersionOp where   arbitrary = arbitraryBoundedEnum
stackctl.cabal view
@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            stackctl-version:         1.6.0.0+version:         1.6.1.0 license:         MIT license-file:    LICENSE copyright:       2022 Renaissance Learning Inc@@ -158,6 +158,8 @@     hs-source-dirs:     test     other-modules:         Stackctl.AWS.CloudFormationSpec+        Stackctl.AWS.EC2Spec+        Stackctl.AWS.LambdaSpec         Stackctl.AWS.ScopeSpec         Stackctl.Config.RequiredVersionSpec         Stackctl.ConfigSpec@@ -167,6 +169,7 @@         Stackctl.StackDescriptionSpec         Stackctl.StackSpecSpec         Stackctl.StackSpecYamlSpec+        Stackctl.Test.App         Paths_stackctl      default-language:   Haskell2010@@ -188,14 +191,21 @@         -optP-Wno-nonportable-include-path      build-depends:+        Blammo >=1.1.2.1,         Glob >=0.10.2,         QuickCheck >=2.14.2,         aeson >=2.0.3.0,+        amazonka-cloudformation >=2.0,+        amazonka-ec2 >=2.0,+        amazonka-lambda >=2.0,+        amazonka-mtl >=0.1.1.0,         base >=4 && <5,         bytestring >=0.11.3.1,         filepath >=1.4.2.2,         hspec >=2.9.7,+        hspec-expectations-lifted >=0.10.0,         hspec-golden >=0.2.1.0,+        lens >=5.1.1,         mtl >=2.2.2,         stackctl,         yaml >=0.11.8.0
test/Stackctl/AWS/CloudFormationSpec.hs view
@@ -2,27 +2,95 @@   ( spec   ) where -import Stackctl.Prelude+import Stackctl.Test.App +import Amazonka.CloudFormation.DeleteChangeSet+import Amazonka.CloudFormation.ListChangeSets+import Amazonka.CloudFormation.Types.ChangeSetSummary+import Blammo.Logging.Logger (LoggedMessage (..), getLoggedMessagesUnsafe)+import qualified Data.Aeson.KeyMap as KeyMap import Data.List (isSuffixOf) import Stackctl.AWS.CloudFormation-import Test.Hspec  spec :: Spec spec = do   describe "readParameter" $ do-    it "refuses empty key" $ do+    it "refuses empty key" $ example $ do       readParameter "=Value"         `shouldSatisfy` either ("empty KEY" `isSuffixOf`) (const False) -    it "refuses empty value" $ do+    it "refuses empty value" $ example $ do       readParameter "Key"         `shouldSatisfy` either ("empty VALUE" `isSuffixOf`) (const False) -    it "refuses empty value (with =)" $ do+    it "refuses empty value (with =)" $ example $ do       readParameter "Key="         `shouldSatisfy` either ("empty VALUE" `isSuffixOf`) (const False) -    it "creates a parameter when valid" $ do+    it "creates a parameter when valid" $ example $ do       readParameter "Key=Value=More"         `shouldBe` Right (makeParameter "Key" $ Just "Value=More")++  describe "awsCloudFormationDeleteAllChangeSets" $ do+    it "deletes all listed changesets" $ example $ runTestAppT $ do+      let+        stackName :: Text+        stackName = "some-stack"++        cs1 :: Text+        cs1 = "some-changeset-1"++        cs2 :: Text+        cs2 = "some-changeset-2"++        cs3 :: Text+        cs3 = "some-changeset-3"++        isListChangeSetsPage :: Maybe Text -> ListChangeSets -> Bool+        isListChangeSetsPage p req =+          and+            [ req ^. listChangeSets_stackName == stackName+            , req ^. listChangeSets_nextToken == p+            ]++        isDeleteChangeSet :: Text -> DeleteChangeSet -> Bool+        isDeleteChangeSet cs req = req ^. deleteChangeSet_changeSetName == cs++        summary1 = newChangeSetSummary & changeSetSummary_changeSetId ?~ cs1+        summary2 = newChangeSetSummary & changeSetSummary_changeSetId ?~ cs2+        summary3 = newChangeSetSummary & changeSetSummary_changeSetId ?~ cs3++        matchers =+          [ SendMatcher (isListChangeSetsPage Nothing)+              $ Right+              $ newListChangeSetsResponse 200+              & (listChangeSetsResponse_summaries ?~ [summary1, summary2])+              & (listChangeSetsResponse_nextToken ?~ "p2")+          , SendMatcher (isListChangeSetsPage $ Just "p2")+              $ Right+              $ newListChangeSetsResponse 200+              & (listChangeSetsResponse_summaries ?~ [summary3])+          , SendMatcher (isDeleteChangeSet cs1)+              $ Right+              $ newDeleteChangeSetResponse 200+          , SendMatcher (isDeleteChangeSet cs2)+              $ Right+              $ newDeleteChangeSetResponse 200+          , SendMatcher (isDeleteChangeSet cs3)+              $ Right+              $ newDeleteChangeSetResponse 200+          ]++      withMatchers matchers $ do+        awsCloudFormationDeleteAllChangeSets $ StackName stackName++        messages <-+          map (loggedMessageText &&& loggedMessageMeta)+            <$> getLoggedMessagesUnsafe++        messages+          `shouldBe` [ ("Deleting all changesets", mempty)+                     , ("Enqueing delete", KeyMap.fromList [("changeSetId", toJSON cs1)])+                     , ("Enqueing delete", KeyMap.fromList [("changeSetId", toJSON cs2)])+                     , ("Enqueing delete", KeyMap.fromList [("changeSetId", toJSON cs3)])+                     ]
+ test/Stackctl/AWS/EC2Spec.hs view
@@ -0,0 +1,29 @@+module Stackctl.AWS.EC2Spec+  ( spec+  ) where++import Stackctl.Test.App++import Amazonka.EC2.DescribeAvailabilityZones+import Amazonka.EC2.Types.AvailabilityZone+import Stackctl.AWS.EC2++spec :: Spec+spec = do+  describe "awsEc2DescribeFirstAvailabilityZoneRegionName" $ do+    it "returns the first AZ's region name" $ example $ runTestAppT $ do+      let+        zones =+          [ newAvailabilityZone & availabilityZone_regionName ?~ "us-east-1"+          , newAvailabilityZone & availabilityZone_regionName ?~ "us-east-2"+          , newAvailabilityZone & availabilityZone_regionName ?~ "us-west-1"+          ]+        matcher =+          SendMatcher (const @_ @DescribeAvailabilityZones True)+            $ Right+            $ newDescribeAvailabilityZonesResponse 200+            & describeAvailabilityZonesResponse_availabilityZones+            ?~ zones++      withMatcher matcher awsEc2DescribeFirstAvailabilityZoneRegionName+        `shouldReturn` "us-east-1"
+ test/Stackctl/AWS/LambdaSpec.hs view
@@ -0,0 +1,65 @@+module Stackctl.AWS.LambdaSpec+  ( spec+  ) where++import Stackctl.Test.App++import Amazonka.Lambda.Invoke+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL+import Stackctl.AWS.Lambda++spec :: Spec+spec = do+  describe "awsLambdaInvoke" $ do+    it "invokes a lambda" $ example $ runTestAppT $ do+      let+        emptyObject = object []++        isInvocation name invoke =+          and+            [ invoke ^. invoke_functionName == name+            , invoke ^. invoke_payload == "{}"+            ]++        lambdaError =+          LambdaError+            { errorType = "exception"+            , errorMessage = "oops"+            , trace = []+            }++        matchers =+          [ SendMatcher (isInvocation "lambda-1")+              $ Right+              $ newInvokeResponse 200+              & invokeResponse_payload+              ?~ "<response>"+          , SendMatcher (isInvocation "lambda-2")+              $ Right+              $ newInvokeResponse 200+              & invokeResponse_payload+              ?~ BSL.toStrict (encode lambdaError)+          , SendMatcher (isInvocation "lambda-3")+              $ Right+              $ newInvokeResponse 500+              & (invokeResponse_payload ?~ "<response>")+              . (invokeResponse_functionError ?~ "<error>")+          ]++      withMatchers matchers $ do+        LambdaInvokeSuccess successPayload <-+          awsLambdaInvoke "lambda-1" emptyObject++        successPayload `shouldBe` "<response>"++        LambdaInvokeError errorPayload _ <-+          awsLambdaInvoke "lambda-2" emptyObject++        errorPayload `shouldBe` lambdaError++        LambdaInvokeFailure failureStatus failureFunctionError <-+          awsLambdaInvoke "lambda-3" emptyObject++        failureStatus `shouldBe` 500+        failureFunctionError `shouldBe` Just "<error>"
+ test/Stackctl/Test/App.hs view
@@ -0,0 +1,57 @@+module Stackctl.Test.App+  ( TestAppT+  , runTestAppT++    -- * Re-exports+  , module Stackctl.Prelude+  , module Control.Lens+  , module Control.Monad.AWS.ViaMock+  , module Test.Hspec+  , module Test.Hspec.Expectations.Lifted+  ) where++import Stackctl.Prelude++import Blammo.Logging.Logger (newTestLogger)+import Control.Lens ((?~))+import Control.Monad.AWS+import Control.Monad.AWS.ViaMock+import Test.Hspec (Spec, describe, example, it)+import Test.Hspec.Expectations.Lifted++data TestApp = TestApp+  { taLogger :: Logger+  , taMatchers :: Matchers+  }++instance HasLogger TestApp where+  loggerL = lens taLogger $ \x y -> x {taLogger = y}++instance HasMatchers TestApp where+  matchersL = lens taMatchers $ \x y -> x {taMatchers = y}++newtype TestAppT m a = TestAppT+  { unTestAppT :: ReaderT TestApp (LoggingT m) a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadUnliftIO+    , MonadLogger+    , MonadReader TestApp+    )+  deriving (MonadAWS) via (MockAWS (TestAppT m))++instance MonadIO m => MonadFail (TestAppT m) where+  fail msg = expectationFailure msg >> error "unreachable"++runTestAppT :: MonadUnliftIO m => TestAppT m a -> m a+runTestAppT f = do+  app <-+    TestApp+      <$> newTestLogger defaultLogSettings+      <*> pure mempty++  runLoggerLoggingT app $ runReaderT (unTestAppT f) app