{-# 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.RegisterType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an extension with the CloudFormation service. Registering an
-- extension makes it available for use in CloudFormation templates in your
-- Amazon Web Services account, and includes:
--
-- -   Validating the extension schema.
--
-- -   Determining which handlers, if any, have been specified for the
--     extension.
--
-- -   Making the extension available for use in your account.
--
-- For more information about how to develop extensions and ready them for
-- registration, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-types.html Creating Resource Providers>
-- in the /CloudFormation CLI User Guide/.
--
-- You can have a maximum of 50 resource extension versions registered at a
-- time. This maximum is per account and per region. Use
-- <AWSCloudFormation/latest/APIReference/API_DeregisterType.html DeregisterType>
-- to deregister specific extension versions if necessary.
--
-- Once you have initiated a registration request using
-- @ @@RegisterType@@ @, you can use @ @@DescribeTypeRegistration@@ @ to
-- monitor the progress of the registration request.
--
-- Once you have registered a private extension in your account and region,
-- use
-- <AWSCloudFormation/latest/APIReference/API_SetTypeConfiguration.html SetTypeConfiguration>
-- to specify configuration properties for the extension. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/registry-register.html#registry-set-configuration Configuring extensions at the account level>
-- in the /CloudFormation User Guide/.
module Amazonka.CloudFormation.RegisterType
  ( -- * Creating a Request
    RegisterType (..),
    newRegisterType,

    -- * Request Lenses
    registerType_clientRequestToken,
    registerType_executionRoleArn,
    registerType_loggingConfig,
    registerType_type,
    registerType_typeName,
    registerType_schemaHandlerPackage,

    -- * Destructuring the Response
    RegisterTypeResponse (..),
    newRegisterTypeResponse,

    -- * Response Lenses
    registerTypeResponse_registrationToken,
    registerTypeResponse_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:/ 'newRegisterType' smart constructor.
data RegisterType = RegisterType'
  { -- | A unique identifier that acts as an idempotency key for this
    -- registration request. Specifying a client request token prevents
    -- CloudFormation from generating more than one version of an extension
    -- from the same registration request, even if the request is submitted
    -- multiple times.
    RegisterType -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM role for CloudFormation to
    -- assume when invoking the extension.
    --
    -- For CloudFormation to assume the specified execution role, the role must
    -- contain a trust relationship with the CloudFormation service principle
    -- (@resources.cloudformation.amazonaws.com@). For more information about
    -- adding trust relationships, see
    -- <IAM/latest/UserGuide/roles-managingrole-editing-console.html#roles-managingrole_edit-trust-policy Modifying a role trust policy>
    -- in the /Identity and Access Management User Guide/.
    --
    -- If your extension calls Amazon Web Services APIs in any of its handlers,
    -- you must create an
    -- /<https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM execution role>/
    -- that includes the necessary permissions to call those Amazon Web
    -- Services APIs, and provision that execution role in your account. When
    -- CloudFormation needs to invoke the resource type handler, CloudFormation
    -- assumes this execution role to create a temporary session token, which
    -- it then passes to the resource type handler, thereby supplying your
    -- resource type with the appropriate credentials.
    RegisterType -> Maybe Text
executionRoleArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies logging configuration information for an extension.
    RegisterType -> Maybe LoggingConfig
loggingConfig :: Prelude.Maybe LoggingConfig,
    -- | The kind of extension.
    RegisterType -> Maybe RegistryType
type' :: Prelude.Maybe RegistryType,
    -- | The name of the extension being registered.
    --
    -- We suggest that extension names adhere to the following patterns:
    --
    -- -   For resource types, /company_or_organization/::/service/::/type/.
    --
    -- -   For modules, /company_or_organization/::/service/::/type/::MODULE.
    --
    -- -   For hooks, /MyCompany/::/Testing/::/MyTestHook/.
    --
    -- The following organization namespaces are reserved and can\'t be used in
    -- your extension names:
    --
    -- -   @Alexa@
    --
    -- -   @AMZN@
    --
    -- -   @Amazon@
    --
    -- -   @AWS@
    --
    -- -   @Custom@
    --
    -- -   @Dev@
    RegisterType -> Text
typeName :: Prelude.Text,
    -- | A URL to the S3 bucket containing the extension project package that
    -- contains the necessary files for the extension you want to register.
    --
    -- For information about generating a schema handler package for the
    -- extension you want to register, see
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-cli-submit.html submit>
    -- in the /CloudFormation CLI User Guide/.
    --
    -- The user registering the extension must be able to access the package in
    -- the S3 bucket. That\'s, the user needs to have
    -- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObject.html GetObject>
    -- permissions for the schema handler package. For more information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
    -- in the /Identity and Access Management User Guide/.
    RegisterType -> Text
schemaHandlerPackage :: Prelude.Text
  }
  deriving (RegisterType -> RegisterType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterType -> RegisterType -> Bool
$c/= :: RegisterType -> RegisterType -> Bool
== :: RegisterType -> RegisterType -> Bool
$c== :: RegisterType -> RegisterType -> Bool
Prelude.Eq, ReadPrec [RegisterType]
ReadPrec RegisterType
Int -> ReadS RegisterType
ReadS [RegisterType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterType]
$creadListPrec :: ReadPrec [RegisterType]
readPrec :: ReadPrec RegisterType
$creadPrec :: ReadPrec RegisterType
readList :: ReadS [RegisterType]
$creadList :: ReadS [RegisterType]
readsPrec :: Int -> ReadS RegisterType
$creadsPrec :: Int -> ReadS RegisterType
Prelude.Read, Int -> RegisterType -> ShowS
[RegisterType] -> ShowS
RegisterType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterType] -> ShowS
$cshowList :: [RegisterType] -> ShowS
show :: RegisterType -> String
$cshow :: RegisterType -> String
showsPrec :: Int -> RegisterType -> ShowS
$cshowsPrec :: Int -> RegisterType -> ShowS
Prelude.Show, forall x. Rep RegisterType x -> RegisterType
forall x. RegisterType -> Rep RegisterType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterType x -> RegisterType
$cfrom :: forall x. RegisterType -> Rep RegisterType x
Prelude.Generic)

-- |
-- Create a value of 'RegisterType' 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:
--
-- 'clientRequestToken', 'registerType_clientRequestToken' - A unique identifier that acts as an idempotency key for this
-- registration request. Specifying a client request token prevents
-- CloudFormation from generating more than one version of an extension
-- from the same registration request, even if the request is submitted
-- multiple times.
--
-- 'executionRoleArn', 'registerType_executionRoleArn' - The Amazon Resource Name (ARN) of the IAM role for CloudFormation to
-- assume when invoking the extension.
--
-- For CloudFormation to assume the specified execution role, the role must
-- contain a trust relationship with the CloudFormation service principle
-- (@resources.cloudformation.amazonaws.com@). For more information about
-- adding trust relationships, see
-- <IAM/latest/UserGuide/roles-managingrole-editing-console.html#roles-managingrole_edit-trust-policy Modifying a role trust policy>
-- in the /Identity and Access Management User Guide/.
--
-- If your extension calls Amazon Web Services APIs in any of its handlers,
-- you must create an
-- /<https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM execution role>/
-- that includes the necessary permissions to call those Amazon Web
-- Services APIs, and provision that execution role in your account. When
-- CloudFormation needs to invoke the resource type handler, CloudFormation
-- assumes this execution role to create a temporary session token, which
-- it then passes to the resource type handler, thereby supplying your
-- resource type with the appropriate credentials.
--
-- 'loggingConfig', 'registerType_loggingConfig' - Specifies logging configuration information for an extension.
--
-- 'type'', 'registerType_type' - The kind of extension.
--
-- 'typeName', 'registerType_typeName' - The name of the extension being registered.
--
-- We suggest that extension names adhere to the following patterns:
--
-- -   For resource types, /company_or_organization/::/service/::/type/.
--
-- -   For modules, /company_or_organization/::/service/::/type/::MODULE.
--
-- -   For hooks, /MyCompany/::/Testing/::/MyTestHook/.
--
-- The following organization namespaces are reserved and can\'t be used in
-- your extension names:
--
-- -   @Alexa@
--
-- -   @AMZN@
--
-- -   @Amazon@
--
-- -   @AWS@
--
-- -   @Custom@
--
-- -   @Dev@
--
-- 'schemaHandlerPackage', 'registerType_schemaHandlerPackage' - A URL to the S3 bucket containing the extension project package that
-- contains the necessary files for the extension you want to register.
--
-- For information about generating a schema handler package for the
-- extension you want to register, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-cli-submit.html submit>
-- in the /CloudFormation CLI User Guide/.
--
-- The user registering the extension must be able to access the package in
-- the S3 bucket. That\'s, the user needs to have
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObject.html GetObject>
-- permissions for the schema handler package. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
-- in the /Identity and Access Management User Guide/.
newRegisterType ::
  -- | 'typeName'
  Prelude.Text ->
  -- | 'schemaHandlerPackage'
  Prelude.Text ->
  RegisterType
newRegisterType :: Text -> Text -> RegisterType
newRegisterType Text
pTypeName_ Text
pSchemaHandlerPackage_ =
  RegisterType'
    { $sel:clientRequestToken:RegisterType' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:executionRoleArn:RegisterType' :: Maybe Text
executionRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingConfig:RegisterType' :: Maybe LoggingConfig
loggingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:type':RegisterType' :: Maybe RegistryType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:RegisterType' :: Text
typeName = Text
pTypeName_,
      $sel:schemaHandlerPackage:RegisterType' :: Text
schemaHandlerPackage = Text
pSchemaHandlerPackage_
    }

-- | A unique identifier that acts as an idempotency key for this
-- registration request. Specifying a client request token prevents
-- CloudFormation from generating more than one version of an extension
-- from the same registration request, even if the request is submitted
-- multiple times.
registerType_clientRequestToken :: Lens.Lens' RegisterType (Prelude.Maybe Prelude.Text)
registerType_clientRequestToken :: Lens' RegisterType (Maybe Text)
registerType_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:RegisterType' :: RegisterType -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: RegisterType
s@RegisterType' {} Maybe Text
a -> RegisterType
s {$sel:clientRequestToken:RegisterType' :: Maybe Text
clientRequestToken = Maybe Text
a} :: RegisterType)

-- | The Amazon Resource Name (ARN) of the IAM role for CloudFormation to
-- assume when invoking the extension.
--
-- For CloudFormation to assume the specified execution role, the role must
-- contain a trust relationship with the CloudFormation service principle
-- (@resources.cloudformation.amazonaws.com@). For more information about
-- adding trust relationships, see
-- <IAM/latest/UserGuide/roles-managingrole-editing-console.html#roles-managingrole_edit-trust-policy Modifying a role trust policy>
-- in the /Identity and Access Management User Guide/.
--
-- If your extension calls Amazon Web Services APIs in any of its handlers,
-- you must create an
-- /<https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM execution role>/
-- that includes the necessary permissions to call those Amazon Web
-- Services APIs, and provision that execution role in your account. When
-- CloudFormation needs to invoke the resource type handler, CloudFormation
-- assumes this execution role to create a temporary session token, which
-- it then passes to the resource type handler, thereby supplying your
-- resource type with the appropriate credentials.
registerType_executionRoleArn :: Lens.Lens' RegisterType (Prelude.Maybe Prelude.Text)
registerType_executionRoleArn :: Lens' RegisterType (Maybe Text)
registerType_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Maybe Text
executionRoleArn :: Maybe Text
$sel:executionRoleArn:RegisterType' :: RegisterType -> Maybe Text
executionRoleArn} -> Maybe Text
executionRoleArn) (\s :: RegisterType
s@RegisterType' {} Maybe Text
a -> RegisterType
s {$sel:executionRoleArn:RegisterType' :: Maybe Text
executionRoleArn = Maybe Text
a} :: RegisterType)

-- | Specifies logging configuration information for an extension.
registerType_loggingConfig :: Lens.Lens' RegisterType (Prelude.Maybe LoggingConfig)
registerType_loggingConfig :: Lens' RegisterType (Maybe LoggingConfig)
registerType_loggingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Maybe LoggingConfig
loggingConfig :: Maybe LoggingConfig
$sel:loggingConfig:RegisterType' :: RegisterType -> Maybe LoggingConfig
loggingConfig} -> Maybe LoggingConfig
loggingConfig) (\s :: RegisterType
s@RegisterType' {} Maybe LoggingConfig
a -> RegisterType
s {$sel:loggingConfig:RegisterType' :: Maybe LoggingConfig
loggingConfig = Maybe LoggingConfig
a} :: RegisterType)

-- | The kind of extension.
registerType_type :: Lens.Lens' RegisterType (Prelude.Maybe RegistryType)
registerType_type :: Lens' RegisterType (Maybe RegistryType)
registerType_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Maybe RegistryType
type' :: Maybe RegistryType
$sel:type':RegisterType' :: RegisterType -> Maybe RegistryType
type'} -> Maybe RegistryType
type') (\s :: RegisterType
s@RegisterType' {} Maybe RegistryType
a -> RegisterType
s {$sel:type':RegisterType' :: Maybe RegistryType
type' = Maybe RegistryType
a} :: RegisterType)

-- | The name of the extension being registered.
--
-- We suggest that extension names adhere to the following patterns:
--
-- -   For resource types, /company_or_organization/::/service/::/type/.
--
-- -   For modules, /company_or_organization/::/service/::/type/::MODULE.
--
-- -   For hooks, /MyCompany/::/Testing/::/MyTestHook/.
--
-- The following organization namespaces are reserved and can\'t be used in
-- your extension names:
--
-- -   @Alexa@
--
-- -   @AMZN@
--
-- -   @Amazon@
--
-- -   @AWS@
--
-- -   @Custom@
--
-- -   @Dev@
registerType_typeName :: Lens.Lens' RegisterType Prelude.Text
registerType_typeName :: Lens' RegisterType Text
registerType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Text
typeName :: Text
$sel:typeName:RegisterType' :: RegisterType -> Text
typeName} -> Text
typeName) (\s :: RegisterType
s@RegisterType' {} Text
a -> RegisterType
s {$sel:typeName:RegisterType' :: Text
typeName = Text
a} :: RegisterType)

-- | A URL to the S3 bucket containing the extension project package that
-- contains the necessary files for the extension you want to register.
--
-- For information about generating a schema handler package for the
-- extension you want to register, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-cli-submit.html submit>
-- in the /CloudFormation CLI User Guide/.
--
-- The user registering the extension must be able to access the package in
-- the S3 bucket. That\'s, the user needs to have
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObject.html GetObject>
-- permissions for the schema handler package. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/list_amazons3.html Actions, Resources, and Condition Keys for Amazon S3>
-- in the /Identity and Access Management User Guide/.
registerType_schemaHandlerPackage :: Lens.Lens' RegisterType Prelude.Text
registerType_schemaHandlerPackage :: Lens' RegisterType Text
registerType_schemaHandlerPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterType' {Text
schemaHandlerPackage :: Text
$sel:schemaHandlerPackage:RegisterType' :: RegisterType -> Text
schemaHandlerPackage} -> Text
schemaHandlerPackage) (\s :: RegisterType
s@RegisterType' {} Text
a -> RegisterType
s {$sel:schemaHandlerPackage:RegisterType' :: Text
schemaHandlerPackage = Text
a} :: RegisterType)

instance Core.AWSRequest RegisterType where
  type AWSResponse RegisterType = RegisterTypeResponse
  request :: (Service -> Service) -> RegisterType -> Request RegisterType
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 RegisterType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterType)))
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
"RegisterTypeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> RegisterTypeResponse
RegisterTypeResponse'
            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
"RegistrationToken")
            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 RegisterType where
  hashWithSalt :: Int -> RegisterType -> Int
hashWithSalt Int
_salt RegisterType' {Maybe Text
Maybe LoggingConfig
Maybe RegistryType
Text
schemaHandlerPackage :: Text
typeName :: Text
type' :: Maybe RegistryType
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
clientRequestToken :: Maybe Text
$sel:schemaHandlerPackage:RegisterType' :: RegisterType -> Text
$sel:typeName:RegisterType' :: RegisterType -> Text
$sel:type':RegisterType' :: RegisterType -> Maybe RegistryType
$sel:loggingConfig:RegisterType' :: RegisterType -> Maybe LoggingConfig
$sel:executionRoleArn:RegisterType' :: RegisterType -> Maybe Text
$sel:clientRequestToken:RegisterType' :: RegisterType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingConfig
loggingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RegistryType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaHandlerPackage

instance Prelude.NFData RegisterType where
  rnf :: RegisterType -> ()
rnf RegisterType' {Maybe Text
Maybe LoggingConfig
Maybe RegistryType
Text
schemaHandlerPackage :: Text
typeName :: Text
type' :: Maybe RegistryType
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
clientRequestToken :: Maybe Text
$sel:schemaHandlerPackage:RegisterType' :: RegisterType -> Text
$sel:typeName:RegisterType' :: RegisterType -> Text
$sel:type':RegisterType' :: RegisterType -> Maybe RegistryType
$sel:loggingConfig:RegisterType' :: RegisterType -> Maybe LoggingConfig
$sel:executionRoleArn:RegisterType' :: RegisterType -> Maybe Text
$sel:clientRequestToken:RegisterType' :: RegisterType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingConfig
loggingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RegistryType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaHandlerPackage

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

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

instance Data.ToQuery RegisterType where
  toQuery :: RegisterType -> QueryString
toQuery RegisterType' {Maybe Text
Maybe LoggingConfig
Maybe RegistryType
Text
schemaHandlerPackage :: Text
typeName :: Text
type' :: Maybe RegistryType
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
clientRequestToken :: Maybe Text
$sel:schemaHandlerPackage:RegisterType' :: RegisterType -> Text
$sel:typeName:RegisterType' :: RegisterType -> Text
$sel:type':RegisterType' :: RegisterType -> Maybe RegistryType
$sel:loggingConfig:RegisterType' :: RegisterType -> Maybe LoggingConfig
$sel:executionRoleArn:RegisterType' :: RegisterType -> Maybe Text
$sel:clientRequestToken:RegisterType' :: RegisterType -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RegisterType" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"ClientRequestToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientRequestToken,
        ByteString
"ExecutionRoleArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
executionRoleArn,
        ByteString
"LoggingConfig" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LoggingConfig
loggingConfig,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RegistryType
type',
        ByteString
"TypeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
typeName,
        ByteString
"SchemaHandlerPackage" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
schemaHandlerPackage
      ]

-- | /See:/ 'newRegisterTypeResponse' smart constructor.
data RegisterTypeResponse = RegisterTypeResponse'
  { -- | The identifier for this registration request.
    --
    -- Use this registration token when calling
    -- @ @@DescribeTypeRegistration@@ @, which returns information about the
    -- status and IDs of the extension registration.
    RegisterTypeResponse -> Maybe Text
registrationToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterTypeResponse -> RegisterTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterTypeResponse -> RegisterTypeResponse -> Bool
$c/= :: RegisterTypeResponse -> RegisterTypeResponse -> Bool
== :: RegisterTypeResponse -> RegisterTypeResponse -> Bool
$c== :: RegisterTypeResponse -> RegisterTypeResponse -> Bool
Prelude.Eq, ReadPrec [RegisterTypeResponse]
ReadPrec RegisterTypeResponse
Int -> ReadS RegisterTypeResponse
ReadS [RegisterTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterTypeResponse]
$creadListPrec :: ReadPrec [RegisterTypeResponse]
readPrec :: ReadPrec RegisterTypeResponse
$creadPrec :: ReadPrec RegisterTypeResponse
readList :: ReadS [RegisterTypeResponse]
$creadList :: ReadS [RegisterTypeResponse]
readsPrec :: Int -> ReadS RegisterTypeResponse
$creadsPrec :: Int -> ReadS RegisterTypeResponse
Prelude.Read, Int -> RegisterTypeResponse -> ShowS
[RegisterTypeResponse] -> ShowS
RegisterTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterTypeResponse] -> ShowS
$cshowList :: [RegisterTypeResponse] -> ShowS
show :: RegisterTypeResponse -> String
$cshow :: RegisterTypeResponse -> String
showsPrec :: Int -> RegisterTypeResponse -> ShowS
$cshowsPrec :: Int -> RegisterTypeResponse -> ShowS
Prelude.Show, forall x. Rep RegisterTypeResponse x -> RegisterTypeResponse
forall x. RegisterTypeResponse -> Rep RegisterTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterTypeResponse x -> RegisterTypeResponse
$cfrom :: forall x. RegisterTypeResponse -> Rep RegisterTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterTypeResponse' 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:
--
-- 'registrationToken', 'registerTypeResponse_registrationToken' - The identifier for this registration request.
--
-- Use this registration token when calling
-- @ @@DescribeTypeRegistration@@ @, which returns information about the
-- status and IDs of the extension registration.
--
-- 'httpStatus', 'registerTypeResponse_httpStatus' - The response's http status code.
newRegisterTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterTypeResponse
newRegisterTypeResponse :: Int -> RegisterTypeResponse
newRegisterTypeResponse Int
pHttpStatus_ =
  RegisterTypeResponse'
    { $sel:registrationToken:RegisterTypeResponse' :: Maybe Text
registrationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier for this registration request.
--
-- Use this registration token when calling
-- @ @@DescribeTypeRegistration@@ @, which returns information about the
-- status and IDs of the extension registration.
registerTypeResponse_registrationToken :: Lens.Lens' RegisterTypeResponse (Prelude.Maybe Prelude.Text)
registerTypeResponse_registrationToken :: Lens' RegisterTypeResponse (Maybe Text)
registerTypeResponse_registrationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTypeResponse' {Maybe Text
registrationToken :: Maybe Text
$sel:registrationToken:RegisterTypeResponse' :: RegisterTypeResponse -> Maybe Text
registrationToken} -> Maybe Text
registrationToken) (\s :: RegisterTypeResponse
s@RegisterTypeResponse' {} Maybe Text
a -> RegisterTypeResponse
s {$sel:registrationToken:RegisterTypeResponse' :: Maybe Text
registrationToken = Maybe Text
a} :: RegisterTypeResponse)

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

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