{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CloudFormation.TestType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests a registered extension to make sure it meets all necessary
-- requirements for being published in the CloudFormation registry.
--
-- -   For resource types, this includes passing all contracts tests
--     defined for the type.
--
-- -   For modules, this includes determining if the module\'s model meets
--     all necessary requirements.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html#publish-extension-testing Testing your public extension prior to publishing>
-- in the /CloudFormation CLI User Guide/.
--
-- If you don\'t specify a version, CloudFormation uses the default version
-- of the extension in your account and region for testing.
--
-- To perform testing, CloudFormation assumes the execution role specified
-- when the type was registered. For more information, see
-- <AWSCloudFormation/latest/APIReference/API_RegisterType.html RegisterType>.
--
-- Once you\'ve initiated testing on an extension using @TestType@, you can
-- pass the returned @TypeVersionArn@ into
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_DescribeType.html DescribeType>
-- to monitor the current test status and test status description for the
-- extension.
--
-- An extension must have a test status of @PASSED@ before it can be
-- published. For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-publish.html Publishing extensions to make them available for public use>
-- in the /CloudFormation CLI User Guide/.
module Amazonka.CloudFormation.TestType
  ( -- * Creating a Request
    TestType (..),
    newTestType,

    -- * Request Lenses
    testType_arn,
    testType_logDeliveryBucket,
    testType_type,
    testType_typeName,
    testType_versionId,

    -- * Destructuring the Response
    TestTypeResponse (..),
    newTestTypeResponse,

    -- * Response Lenses
    testTypeResponse_typeVersionArn,
    testTypeResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTestType' smart constructor.
data TestType = TestType'
  { -- | The Amazon Resource Name (ARN) of the extension.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    TestType -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The S3 bucket to which CloudFormation delivers the contract test
    -- execution logs.
    --
    -- CloudFormation delivers the logs by the time contract testing has
    -- completed and the extension has been assigned a test type status of
    -- @PASSED@ or @FAILED@.
    --
    -- The user calling @TestType@ must be able to access items in the
    -- specified S3 bucket. Specifically, the user needs the following
    -- permissions:
    --
    -- -   @GetObject@
    --
    -- -   @PutObject@
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
    -- in the /Amazon Web Services Identity and Access Management User Guide/.
    TestType -> Maybe Text
logDeliveryBucket :: Prelude.Maybe Prelude.Text,
    -- | The type of the extension to test.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    TestType -> Maybe ThirdPartyType
type' :: Prelude.Maybe ThirdPartyType,
    -- | The name of the extension to test.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    TestType -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | The version of the extension to test.
    --
    -- You can specify the version id with either @Arn@, or with @TypeName@ and
    -- @Type@.
    --
    -- If you don\'t specify a version, CloudFormation uses the default version
    -- of the extension in this account and region for testing.
    TestType -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text
  }
  deriving (TestType -> TestType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestType -> TestType -> Bool
$c/= :: TestType -> TestType -> Bool
== :: TestType -> TestType -> Bool
$c== :: TestType -> TestType -> Bool
Prelude.Eq, ReadPrec [TestType]
ReadPrec TestType
Int -> ReadS TestType
ReadS [TestType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestType]
$creadListPrec :: ReadPrec [TestType]
readPrec :: ReadPrec TestType
$creadPrec :: ReadPrec TestType
readList :: ReadS [TestType]
$creadList :: ReadS [TestType]
readsPrec :: Int -> ReadS TestType
$creadsPrec :: Int -> ReadS TestType
Prelude.Read, Int -> TestType -> ShowS
[TestType] -> ShowS
TestType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestType] -> ShowS
$cshowList :: [TestType] -> ShowS
show :: TestType -> String
$cshow :: TestType -> String
showsPrec :: Int -> TestType -> ShowS
$cshowsPrec :: Int -> TestType -> ShowS
Prelude.Show, forall x. Rep TestType x -> TestType
forall x. TestType -> Rep TestType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestType x -> TestType
$cfrom :: forall x. TestType -> Rep TestType x
Prelude.Generic)

-- |
-- Create a value of 'TestType' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'arn', 'testType_arn' - The Amazon Resource Name (ARN) of the extension.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
--
-- 'logDeliveryBucket', 'testType_logDeliveryBucket' - The S3 bucket to which CloudFormation delivers the contract test
-- execution logs.
--
-- CloudFormation delivers the logs by the time contract testing has
-- completed and the extension has been assigned a test type status of
-- @PASSED@ or @FAILED@.
--
-- The user calling @TestType@ must be able to access items in the
-- specified S3 bucket. Specifically, the user needs the following
-- permissions:
--
-- -   @GetObject@
--
-- -   @PutObject@
--
-- For more information, see
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
-- in the /Amazon Web Services Identity and Access Management User Guide/.
--
-- 'type'', 'testType_type' - The type of the extension to test.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
--
-- 'typeName', 'testType_typeName' - The name of the extension to test.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
--
-- 'versionId', 'testType_versionId' - The version of the extension to test.
--
-- You can specify the version id with either @Arn@, or with @TypeName@ and
-- @Type@.
--
-- If you don\'t specify a version, CloudFormation uses the default version
-- of the extension in this account and region for testing.
newTestType ::
  TestType
newTestType :: TestType
newTestType =
  TestType'
    { $sel:arn:TestType' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:logDeliveryBucket:TestType' :: Maybe Text
logDeliveryBucket = forall a. Maybe a
Prelude.Nothing,
      $sel:type':TestType' :: Maybe ThirdPartyType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:TestType' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:TestType' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the extension.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
testType_arn :: Lens.Lens' TestType (Prelude.Maybe Prelude.Text)
testType_arn :: Lens' TestType (Maybe Text)
testType_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestType' {Maybe Text
arn :: Maybe Text
$sel:arn:TestType' :: TestType -> Maybe Text
arn} -> Maybe Text
arn) (\s :: TestType
s@TestType' {} Maybe Text
a -> TestType
s {$sel:arn:TestType' :: Maybe Text
arn = Maybe Text
a} :: TestType)

-- | The S3 bucket to which CloudFormation delivers the contract test
-- execution logs.
--
-- CloudFormation delivers the logs by the time contract testing has
-- completed and the extension has been assigned a test type status of
-- @PASSED@ or @FAILED@.
--
-- The user calling @TestType@ must be able to access items in the
-- specified S3 bucket. Specifically, the user needs the following
-- permissions:
--
-- -   @GetObject@
--
-- -   @PutObject@
--
-- For more information, see
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
-- in the /Amazon Web Services Identity and Access Management User Guide/.
testType_logDeliveryBucket :: Lens.Lens' TestType (Prelude.Maybe Prelude.Text)
testType_logDeliveryBucket :: Lens' TestType (Maybe Text)
testType_logDeliveryBucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestType' {Maybe Text
logDeliveryBucket :: Maybe Text
$sel:logDeliveryBucket:TestType' :: TestType -> Maybe Text
logDeliveryBucket} -> Maybe Text
logDeliveryBucket) (\s :: TestType
s@TestType' {} Maybe Text
a -> TestType
s {$sel:logDeliveryBucket:TestType' :: Maybe Text
logDeliveryBucket = Maybe Text
a} :: TestType)

-- | The type of the extension to test.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
testType_type :: Lens.Lens' TestType (Prelude.Maybe ThirdPartyType)
testType_type :: Lens' TestType (Maybe ThirdPartyType)
testType_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestType' {Maybe ThirdPartyType
type' :: Maybe ThirdPartyType
$sel:type':TestType' :: TestType -> Maybe ThirdPartyType
type'} -> Maybe ThirdPartyType
type') (\s :: TestType
s@TestType' {} Maybe ThirdPartyType
a -> TestType
s {$sel:type':TestType' :: Maybe ThirdPartyType
type' = Maybe ThirdPartyType
a} :: TestType)

-- | The name of the extension to test.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
testType_typeName :: Lens.Lens' TestType (Prelude.Maybe Prelude.Text)
testType_typeName :: Lens' TestType (Maybe Text)
testType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestType' {Maybe Text
typeName :: Maybe Text
$sel:typeName:TestType' :: TestType -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: TestType
s@TestType' {} Maybe Text
a -> TestType
s {$sel:typeName:TestType' :: Maybe Text
typeName = Maybe Text
a} :: TestType)

-- | The version of the extension to test.
--
-- You can specify the version id with either @Arn@, or with @TypeName@ and
-- @Type@.
--
-- If you don\'t specify a version, CloudFormation uses the default version
-- of the extension in this account and region for testing.
testType_versionId :: Lens.Lens' TestType (Prelude.Maybe Prelude.Text)
testType_versionId :: Lens' TestType (Maybe Text)
testType_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestType' {Maybe Text
versionId :: Maybe Text
$sel:versionId:TestType' :: TestType -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: TestType
s@TestType' {} Maybe Text
a -> TestType
s {$sel:versionId:TestType' :: Maybe Text
versionId = Maybe Text
a} :: TestType)

instance Core.AWSRequest TestType where
  type AWSResponse TestType = TestTypeResponse
  request :: (Service -> Service) -> TestType -> Request TestType
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy TestType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestType)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"TestTypeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> TestTypeResponse
TestTypeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TypeVersionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable TestType where
  hashWithSalt :: Int -> TestType -> Int
hashWithSalt Int
_salt TestType' {Maybe Text
Maybe ThirdPartyType
versionId :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
logDeliveryBucket :: Maybe Text
arn :: Maybe Text
$sel:versionId:TestType' :: TestType -> Maybe Text
$sel:typeName:TestType' :: TestType -> Maybe Text
$sel:type':TestType' :: TestType -> Maybe ThirdPartyType
$sel:logDeliveryBucket:TestType' :: TestType -> Maybe Text
$sel:arn:TestType' :: TestType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logDeliveryBucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThirdPartyType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
versionId

instance Prelude.NFData TestType where
  rnf :: TestType -> ()
rnf TestType' {Maybe Text
Maybe ThirdPartyType
versionId :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
logDeliveryBucket :: Maybe Text
arn :: Maybe Text
$sel:versionId:TestType' :: TestType -> Maybe Text
$sel:typeName:TestType' :: TestType -> Maybe Text
$sel:type':TestType' :: TestType -> Maybe ThirdPartyType
$sel:logDeliveryBucket:TestType' :: TestType -> Maybe Text
$sel:arn:TestType' :: TestType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logDeliveryBucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThirdPartyType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionId

instance Data.ToHeaders TestType where
  toHeaders :: TestType -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath TestType where
  toPath :: TestType -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery TestType where
  toQuery :: TestType -> QueryString
toQuery TestType' {Maybe Text
Maybe ThirdPartyType
versionId :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
logDeliveryBucket :: Maybe Text
arn :: Maybe Text
$sel:versionId:TestType' :: TestType -> Maybe Text
$sel:typeName:TestType' :: TestType -> Maybe Text
$sel:type':TestType' :: TestType -> Maybe ThirdPartyType
$sel:logDeliveryBucket:TestType' :: TestType -> Maybe Text
$sel:arn:TestType' :: TestType -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"TestType" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"Arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
arn,
        ByteString
"LogDeliveryBucket" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
logDeliveryBucket,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ThirdPartyType
type',
        ByteString
"TypeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeName,
        ByteString
"VersionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
versionId
      ]

-- | /See:/ 'newTestTypeResponse' smart constructor.
data TestTypeResponse = TestTypeResponse'
  { -- | The Amazon Resource Name (ARN) of the extension.
    TestTypeResponse -> Maybe Text
typeVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    TestTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestTypeResponse -> TestTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestTypeResponse -> TestTypeResponse -> Bool
$c/= :: TestTypeResponse -> TestTypeResponse -> Bool
== :: TestTypeResponse -> TestTypeResponse -> Bool
$c== :: TestTypeResponse -> TestTypeResponse -> Bool
Prelude.Eq, ReadPrec [TestTypeResponse]
ReadPrec TestTypeResponse
Int -> ReadS TestTypeResponse
ReadS [TestTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestTypeResponse]
$creadListPrec :: ReadPrec [TestTypeResponse]
readPrec :: ReadPrec TestTypeResponse
$creadPrec :: ReadPrec TestTypeResponse
readList :: ReadS [TestTypeResponse]
$creadList :: ReadS [TestTypeResponse]
readsPrec :: Int -> ReadS TestTypeResponse
$creadsPrec :: Int -> ReadS TestTypeResponse
Prelude.Read, Int -> TestTypeResponse -> ShowS
[TestTypeResponse] -> ShowS
TestTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestTypeResponse] -> ShowS
$cshowList :: [TestTypeResponse] -> ShowS
show :: TestTypeResponse -> String
$cshow :: TestTypeResponse -> String
showsPrec :: Int -> TestTypeResponse -> ShowS
$cshowsPrec :: Int -> TestTypeResponse -> ShowS
Prelude.Show, forall x. Rep TestTypeResponse x -> TestTypeResponse
forall x. TestTypeResponse -> Rep TestTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestTypeResponse x -> TestTypeResponse
$cfrom :: forall x. TestTypeResponse -> Rep TestTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestTypeResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'typeVersionArn', 'testTypeResponse_typeVersionArn' - The Amazon Resource Name (ARN) of the extension.
--
-- 'httpStatus', 'testTypeResponse_httpStatus' - The response's http status code.
newTestTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestTypeResponse
newTestTypeResponse :: Int -> TestTypeResponse
newTestTypeResponse Int
pHttpStatus_ =
  TestTypeResponse'
    { $sel:typeVersionArn:TestTypeResponse' :: Maybe Text
typeVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the extension.
testTypeResponse_typeVersionArn :: Lens.Lens' TestTypeResponse (Prelude.Maybe Prelude.Text)
testTypeResponse_typeVersionArn :: Lens' TestTypeResponse (Maybe Text)
testTypeResponse_typeVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestTypeResponse' {Maybe Text
typeVersionArn :: Maybe Text
$sel:typeVersionArn:TestTypeResponse' :: TestTypeResponse -> Maybe Text
typeVersionArn} -> Maybe Text
typeVersionArn) (\s :: TestTypeResponse
s@TestTypeResponse' {} Maybe Text
a -> TestTypeResponse
s {$sel:typeVersionArn:TestTypeResponse' :: Maybe Text
typeVersionArn = Maybe Text
a} :: TestTypeResponse)

-- | The response's http status code.
testTypeResponse_httpStatus :: Lens.Lens' TestTypeResponse Prelude.Int
testTypeResponse_httpStatus :: Lens' TestTypeResponse Int
testTypeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestTypeResponse' {Int
httpStatus :: Int
$sel:httpStatus:TestTypeResponse' :: TestTypeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: TestTypeResponse
s@TestTypeResponse' {} Int
a -> TestTypeResponse
s {$sel:httpStatus:TestTypeResponse' :: Int
httpStatus = Int
a} :: TestTypeResponse)

instance Prelude.NFData TestTypeResponse where
  rnf :: TestTypeResponse -> ()
rnf TestTypeResponse' {Int
Maybe Text
httpStatus :: Int
typeVersionArn :: Maybe Text
$sel:httpStatus:TestTypeResponse' :: TestTypeResponse -> Int
$sel:typeVersionArn:TestTypeResponse' :: TestTypeResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus