{-# 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.PublishType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Publishes the specified extension to the CloudFormation registry as a
-- public extension in this region. Public extensions are available for use
-- by all CloudFormation users. For more information about publishing
-- extensions, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html Publishing extensions to make them available for public use>
-- in the /CloudFormation CLI User Guide/.
--
-- To publish an extension, you must be registered as a publisher with
-- CloudFormation. For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_RegisterPublisher.html RegisterPublisher>.
module Amazonka.CloudFormation.PublishType
  ( -- * Creating a Request
    PublishType (..),
    newPublishType,

    -- * Request Lenses
    publishType_arn,
    publishType_publicVersionNumber,
    publishType_type,
    publishType_typeName,

    -- * Destructuring the Response
    PublishTypeResponse (..),
    newPublishTypeResponse,

    -- * Response Lenses
    publishTypeResponse_publicTypeArn,
    publishTypeResponse_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:/ 'newPublishType' smart constructor.
data PublishType = PublishType'
  { -- | The Amazon Resource Name (ARN) of the extension.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    PublishType -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The version number to assign to this version of the extension.
    --
    -- Use the following format, and adhere to semantic versioning when
    -- assigning a version number to your extension:
    --
    -- @MAJOR.MINOR.PATCH@
    --
    -- For more information, see
    -- <https://semver.org/ Semantic Versioning 2.0.0>.
    --
    -- If you don\'t specify a version number, CloudFormation increments the
    -- version number by one minor version release.
    --
    -- You cannot specify a version number the first time you publish a type.
    -- CloudFormation automatically sets the first version number to be
    -- @1.0.0@.
    PublishType -> Maybe Text
publicVersionNumber :: Prelude.Maybe Prelude.Text,
    -- | The type of the extension.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    PublishType -> Maybe ThirdPartyType
type' :: Prelude.Maybe ThirdPartyType,
    -- | The name of the extension.
    --
    -- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
    PublishType -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text
  }
  deriving (PublishType -> PublishType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishType -> PublishType -> Bool
$c/= :: PublishType -> PublishType -> Bool
== :: PublishType -> PublishType -> Bool
$c== :: PublishType -> PublishType -> Bool
Prelude.Eq, ReadPrec [PublishType]
ReadPrec PublishType
Int -> ReadS PublishType
ReadS [PublishType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishType]
$creadListPrec :: ReadPrec [PublishType]
readPrec :: ReadPrec PublishType
$creadPrec :: ReadPrec PublishType
readList :: ReadS [PublishType]
$creadList :: ReadS [PublishType]
readsPrec :: Int -> ReadS PublishType
$creadsPrec :: Int -> ReadS PublishType
Prelude.Read, Int -> PublishType -> ShowS
[PublishType] -> ShowS
PublishType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishType] -> ShowS
$cshowList :: [PublishType] -> ShowS
show :: PublishType -> String
$cshow :: PublishType -> String
showsPrec :: Int -> PublishType -> ShowS
$cshowsPrec :: Int -> PublishType -> ShowS
Prelude.Show, forall x. Rep PublishType x -> PublishType
forall x. PublishType -> Rep PublishType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublishType x -> PublishType
$cfrom :: forall x. PublishType -> Rep PublishType x
Prelude.Generic)

-- |
-- Create a value of 'PublishType' 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', 'publishType_arn' - The Amazon Resource Name (ARN) of the extension.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
--
-- 'publicVersionNumber', 'publishType_publicVersionNumber' - The version number to assign to this version of the extension.
--
-- Use the following format, and adhere to semantic versioning when
-- assigning a version number to your extension:
--
-- @MAJOR.MINOR.PATCH@
--
-- For more information, see
-- <https://semver.org/ Semantic Versioning 2.0.0>.
--
-- If you don\'t specify a version number, CloudFormation increments the
-- version number by one minor version release.
--
-- You cannot specify a version number the first time you publish a type.
-- CloudFormation automatically sets the first version number to be
-- @1.0.0@.
--
-- 'type'', 'publishType_type' - The type of the extension.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
--
-- 'typeName', 'publishType_typeName' - The name of the extension.
--
-- Conditional: You must specify @Arn@, or @TypeName@ and @Type@.
newPublishType ::
  PublishType
newPublishType :: PublishType
newPublishType =
  PublishType'
    { $sel:arn:PublishType' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:publicVersionNumber:PublishType' :: Maybe Text
publicVersionNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:type':PublishType' :: Maybe ThirdPartyType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:PublishType' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The version number to assign to this version of the extension.
--
-- Use the following format, and adhere to semantic versioning when
-- assigning a version number to your extension:
--
-- @MAJOR.MINOR.PATCH@
--
-- For more information, see
-- <https://semver.org/ Semantic Versioning 2.0.0>.
--
-- If you don\'t specify a version number, CloudFormation increments the
-- version number by one minor version release.
--
-- You cannot specify a version number the first time you publish a type.
-- CloudFormation automatically sets the first version number to be
-- @1.0.0@.
publishType_publicVersionNumber :: Lens.Lens' PublishType (Prelude.Maybe Prelude.Text)
publishType_publicVersionNumber :: Lens' PublishType (Maybe Text)
publishType_publicVersionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublishType' {Maybe Text
publicVersionNumber :: Maybe Text
$sel:publicVersionNumber:PublishType' :: PublishType -> Maybe Text
publicVersionNumber} -> Maybe Text
publicVersionNumber) (\s :: PublishType
s@PublishType' {} Maybe Text
a -> PublishType
s {$sel:publicVersionNumber:PublishType' :: Maybe Text
publicVersionNumber = Maybe Text
a} :: PublishType)

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

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

instance Core.AWSRequest PublishType where
  type AWSResponse PublishType = PublishTypeResponse
  request :: (Service -> Service) -> PublishType -> Request PublishType
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 PublishType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PublishType)))
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
"PublishTypeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> PublishTypeResponse
PublishTypeResponse'
            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
"PublicTypeArn")
            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 PublishType where
  hashWithSalt :: Int -> PublishType -> Int
hashWithSalt Int
_salt PublishType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publicVersionNumber :: Maybe Text
arn :: Maybe Text
$sel:typeName:PublishType' :: PublishType -> Maybe Text
$sel:type':PublishType' :: PublishType -> Maybe ThirdPartyType
$sel:publicVersionNumber:PublishType' :: PublishType -> Maybe Text
$sel:arn:PublishType' :: PublishType -> 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
publicVersionNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThirdPartyType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName

instance Prelude.NFData PublishType where
  rnf :: PublishType -> ()
rnf PublishType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publicVersionNumber :: Maybe Text
arn :: Maybe Text
$sel:typeName:PublishType' :: PublishType -> Maybe Text
$sel:type':PublishType' :: PublishType -> Maybe ThirdPartyType
$sel:publicVersionNumber:PublishType' :: PublishType -> Maybe Text
$sel:arn:PublishType' :: PublishType -> 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
publicVersionNumber
      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

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

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

instance Data.ToQuery PublishType where
  toQuery :: PublishType -> QueryString
toQuery PublishType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publicVersionNumber :: Maybe Text
arn :: Maybe Text
$sel:typeName:PublishType' :: PublishType -> Maybe Text
$sel:type':PublishType' :: PublishType -> Maybe ThirdPartyType
$sel:publicVersionNumber:PublishType' :: PublishType -> Maybe Text
$sel:arn:PublishType' :: PublishType -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PublishType" :: 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
"PublicVersionNumber" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
publicVersionNumber,
        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
      ]

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

-- |
-- Create a value of 'PublishTypeResponse' 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:
--
-- 'publicTypeArn', 'publishTypeResponse_publicTypeArn' - The Amazon Resource Name (ARN) assigned to the public extension upon
-- publication.
--
-- 'httpStatus', 'publishTypeResponse_httpStatus' - The response's http status code.
newPublishTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PublishTypeResponse
newPublishTypeResponse :: Int -> PublishTypeResponse
newPublishTypeResponse Int
pHttpStatus_ =
  PublishTypeResponse'
    { $sel:publicTypeArn:PublishTypeResponse' :: Maybe Text
publicTypeArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PublishTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) assigned to the public extension upon
-- publication.
publishTypeResponse_publicTypeArn :: Lens.Lens' PublishTypeResponse (Prelude.Maybe Prelude.Text)
publishTypeResponse_publicTypeArn :: Lens' PublishTypeResponse (Maybe Text)
publishTypeResponse_publicTypeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublishTypeResponse' {Maybe Text
publicTypeArn :: Maybe Text
$sel:publicTypeArn:PublishTypeResponse' :: PublishTypeResponse -> Maybe Text
publicTypeArn} -> Maybe Text
publicTypeArn) (\s :: PublishTypeResponse
s@PublishTypeResponse' {} Maybe Text
a -> PublishTypeResponse
s {$sel:publicTypeArn:PublishTypeResponse' :: Maybe Text
publicTypeArn = Maybe Text
a} :: PublishTypeResponse)

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

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