{-# 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.RegisterPublisher
-- 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 your account as a publisher of public extensions in the
-- CloudFormation registry. Public extensions are available for use by all
-- CloudFormation users. This publisher ID applies to your account in all
-- Amazon Web Services Regions.
--
-- For information about requirements for registering as a public extension
-- publisher, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html#publish-extension-prereqs Registering your account to publish CloudFormation extensions>
-- in the /CloudFormation CLI User Guide/.
module Amazonka.CloudFormation.RegisterPublisher
  ( -- * Creating a Request
    RegisterPublisher (..),
    newRegisterPublisher,

    -- * Request Lenses
    registerPublisher_acceptTermsAndConditions,
    registerPublisher_connectionArn,

    -- * Destructuring the Response
    RegisterPublisherResponse (..),
    newRegisterPublisherResponse,

    -- * Response Lenses
    registerPublisherResponse_publisherId,
    registerPublisherResponse_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:/ 'newRegisterPublisher' smart constructor.
data RegisterPublisher = RegisterPublisher'
  { -- | Whether you accept the
    -- <https://cloudformation-registry-documents.s3.amazonaws.com/Terms_and_Conditions_for_AWS_CloudFormation_Registry_Publishers.pdf Terms and Conditions>
    -- for publishing extensions in the CloudFormation registry. You must
    -- accept the terms and conditions in order to register to publish public
    -- extensions to the CloudFormation registry.
    --
    -- The default is @false@.
    RegisterPublisher -> Maybe Bool
acceptTermsAndConditions :: Prelude.Maybe Prelude.Bool,
    -- | If you are using a Bitbucket or GitHub account for identity
    -- verification, the Amazon Resource Name (ARN) for your connection to that
    -- account.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html#publish-extension-prereqs Registering your account to publish CloudFormation extensions>
    -- in the /CloudFormation CLI User Guide/.
    RegisterPublisher -> Maybe Text
connectionArn :: Prelude.Maybe Prelude.Text
  }
  deriving (RegisterPublisher -> RegisterPublisher -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterPublisher -> RegisterPublisher -> Bool
$c/= :: RegisterPublisher -> RegisterPublisher -> Bool
== :: RegisterPublisher -> RegisterPublisher -> Bool
$c== :: RegisterPublisher -> RegisterPublisher -> Bool
Prelude.Eq, ReadPrec [RegisterPublisher]
ReadPrec RegisterPublisher
Int -> ReadS RegisterPublisher
ReadS [RegisterPublisher]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterPublisher]
$creadListPrec :: ReadPrec [RegisterPublisher]
readPrec :: ReadPrec RegisterPublisher
$creadPrec :: ReadPrec RegisterPublisher
readList :: ReadS [RegisterPublisher]
$creadList :: ReadS [RegisterPublisher]
readsPrec :: Int -> ReadS RegisterPublisher
$creadsPrec :: Int -> ReadS RegisterPublisher
Prelude.Read, Int -> RegisterPublisher -> ShowS
[RegisterPublisher] -> ShowS
RegisterPublisher -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterPublisher] -> ShowS
$cshowList :: [RegisterPublisher] -> ShowS
show :: RegisterPublisher -> String
$cshow :: RegisterPublisher -> String
showsPrec :: Int -> RegisterPublisher -> ShowS
$cshowsPrec :: Int -> RegisterPublisher -> ShowS
Prelude.Show, forall x. Rep RegisterPublisher x -> RegisterPublisher
forall x. RegisterPublisher -> Rep RegisterPublisher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterPublisher x -> RegisterPublisher
$cfrom :: forall x. RegisterPublisher -> Rep RegisterPublisher x
Prelude.Generic)

-- |
-- Create a value of 'RegisterPublisher' 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:
--
-- 'acceptTermsAndConditions', 'registerPublisher_acceptTermsAndConditions' - Whether you accept the
-- <https://cloudformation-registry-documents.s3.amazonaws.com/Terms_and_Conditions_for_AWS_CloudFormation_Registry_Publishers.pdf Terms and Conditions>
-- for publishing extensions in the CloudFormation registry. You must
-- accept the terms and conditions in order to register to publish public
-- extensions to the CloudFormation registry.
--
-- The default is @false@.
--
-- 'connectionArn', 'registerPublisher_connectionArn' - If you are using a Bitbucket or GitHub account for identity
-- verification, the Amazon Resource Name (ARN) for your connection to that
-- account.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html#publish-extension-prereqs Registering your account to publish CloudFormation extensions>
-- in the /CloudFormation CLI User Guide/.
newRegisterPublisher ::
  RegisterPublisher
newRegisterPublisher :: RegisterPublisher
newRegisterPublisher =
  RegisterPublisher'
    { $sel:acceptTermsAndConditions:RegisterPublisher' :: Maybe Bool
acceptTermsAndConditions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:connectionArn:RegisterPublisher' :: Maybe Text
connectionArn = forall a. Maybe a
Prelude.Nothing
    }

-- | Whether you accept the
-- <https://cloudformation-registry-documents.s3.amazonaws.com/Terms_and_Conditions_for_AWS_CloudFormation_Registry_Publishers.pdf Terms and Conditions>
-- for publishing extensions in the CloudFormation registry. You must
-- accept the terms and conditions in order to register to publish public
-- extensions to the CloudFormation registry.
--
-- The default is @false@.
registerPublisher_acceptTermsAndConditions :: Lens.Lens' RegisterPublisher (Prelude.Maybe Prelude.Bool)
registerPublisher_acceptTermsAndConditions :: Lens' RegisterPublisher (Maybe Bool)
registerPublisher_acceptTermsAndConditions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPublisher' {Maybe Bool
acceptTermsAndConditions :: Maybe Bool
$sel:acceptTermsAndConditions:RegisterPublisher' :: RegisterPublisher -> Maybe Bool
acceptTermsAndConditions} -> Maybe Bool
acceptTermsAndConditions) (\s :: RegisterPublisher
s@RegisterPublisher' {} Maybe Bool
a -> RegisterPublisher
s {$sel:acceptTermsAndConditions:RegisterPublisher' :: Maybe Bool
acceptTermsAndConditions = Maybe Bool
a} :: RegisterPublisher)

-- | If you are using a Bitbucket or GitHub account for identity
-- verification, the Amazon Resource Name (ARN) for your connection to that
-- account.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/publish-extension.html#publish-extension-prereqs Registering your account to publish CloudFormation extensions>
-- in the /CloudFormation CLI User Guide/.
registerPublisher_connectionArn :: Lens.Lens' RegisterPublisher (Prelude.Maybe Prelude.Text)
registerPublisher_connectionArn :: Lens' RegisterPublisher (Maybe Text)
registerPublisher_connectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPublisher' {Maybe Text
connectionArn :: Maybe Text
$sel:connectionArn:RegisterPublisher' :: RegisterPublisher -> Maybe Text
connectionArn} -> Maybe Text
connectionArn) (\s :: RegisterPublisher
s@RegisterPublisher' {} Maybe Text
a -> RegisterPublisher
s {$sel:connectionArn:RegisterPublisher' :: Maybe Text
connectionArn = Maybe Text
a} :: RegisterPublisher)

instance Core.AWSRequest RegisterPublisher where
  type
    AWSResponse RegisterPublisher =
      RegisterPublisherResponse
  request :: (Service -> Service)
-> RegisterPublisher -> Request RegisterPublisher
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 RegisterPublisher
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterPublisher)))
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
"RegisterPublisherResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> RegisterPublisherResponse
RegisterPublisherResponse'
            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
"PublisherId")
            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 RegisterPublisher where
  hashWithSalt :: Int -> RegisterPublisher -> Int
hashWithSalt Int
_salt RegisterPublisher' {Maybe Bool
Maybe Text
connectionArn :: Maybe Text
acceptTermsAndConditions :: Maybe Bool
$sel:connectionArn:RegisterPublisher' :: RegisterPublisher -> Maybe Text
$sel:acceptTermsAndConditions:RegisterPublisher' :: RegisterPublisher -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
acceptTermsAndConditions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionArn

instance Prelude.NFData RegisterPublisher where
  rnf :: RegisterPublisher -> ()
rnf RegisterPublisher' {Maybe Bool
Maybe Text
connectionArn :: Maybe Text
acceptTermsAndConditions :: Maybe Bool
$sel:connectionArn:RegisterPublisher' :: RegisterPublisher -> Maybe Text
$sel:acceptTermsAndConditions:RegisterPublisher' :: RegisterPublisher -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
acceptTermsAndConditions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionArn

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

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

instance Data.ToQuery RegisterPublisher where
  toQuery :: RegisterPublisher -> QueryString
toQuery RegisterPublisher' {Maybe Bool
Maybe Text
connectionArn :: Maybe Text
acceptTermsAndConditions :: Maybe Bool
$sel:connectionArn:RegisterPublisher' :: RegisterPublisher -> Maybe Text
$sel:acceptTermsAndConditions:RegisterPublisher' :: RegisterPublisher -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RegisterPublisher" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"AcceptTermsAndConditions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
acceptTermsAndConditions,
        ByteString
"ConnectionArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
connectionArn
      ]

-- | /See:/ 'newRegisterPublisherResponse' smart constructor.
data RegisterPublisherResponse = RegisterPublisherResponse'
  { -- | The ID assigned this account by CloudFormation for publishing
    -- extensions.
    RegisterPublisherResponse -> Maybe Text
publisherId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterPublisherResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterPublisherResponse -> RegisterPublisherResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterPublisherResponse -> RegisterPublisherResponse -> Bool
$c/= :: RegisterPublisherResponse -> RegisterPublisherResponse -> Bool
== :: RegisterPublisherResponse -> RegisterPublisherResponse -> Bool
$c== :: RegisterPublisherResponse -> RegisterPublisherResponse -> Bool
Prelude.Eq, ReadPrec [RegisterPublisherResponse]
ReadPrec RegisterPublisherResponse
Int -> ReadS RegisterPublisherResponse
ReadS [RegisterPublisherResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterPublisherResponse]
$creadListPrec :: ReadPrec [RegisterPublisherResponse]
readPrec :: ReadPrec RegisterPublisherResponse
$creadPrec :: ReadPrec RegisterPublisherResponse
readList :: ReadS [RegisterPublisherResponse]
$creadList :: ReadS [RegisterPublisherResponse]
readsPrec :: Int -> ReadS RegisterPublisherResponse
$creadsPrec :: Int -> ReadS RegisterPublisherResponse
Prelude.Read, Int -> RegisterPublisherResponse -> ShowS
[RegisterPublisherResponse] -> ShowS
RegisterPublisherResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterPublisherResponse] -> ShowS
$cshowList :: [RegisterPublisherResponse] -> ShowS
show :: RegisterPublisherResponse -> String
$cshow :: RegisterPublisherResponse -> String
showsPrec :: Int -> RegisterPublisherResponse -> ShowS
$cshowsPrec :: Int -> RegisterPublisherResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterPublisherResponse x -> RegisterPublisherResponse
forall x.
RegisterPublisherResponse -> Rep RegisterPublisherResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterPublisherResponse x -> RegisterPublisherResponse
$cfrom :: forall x.
RegisterPublisherResponse -> Rep RegisterPublisherResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterPublisherResponse' 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:
--
-- 'publisherId', 'registerPublisherResponse_publisherId' - The ID assigned this account by CloudFormation for publishing
-- extensions.
--
-- 'httpStatus', 'registerPublisherResponse_httpStatus' - The response's http status code.
newRegisterPublisherResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterPublisherResponse
newRegisterPublisherResponse :: Int -> RegisterPublisherResponse
newRegisterPublisherResponse Int
pHttpStatus_ =
  RegisterPublisherResponse'
    { $sel:publisherId:RegisterPublisherResponse' :: Maybe Text
publisherId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterPublisherResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID assigned this account by CloudFormation for publishing
-- extensions.
registerPublisherResponse_publisherId :: Lens.Lens' RegisterPublisherResponse (Prelude.Maybe Prelude.Text)
registerPublisherResponse_publisherId :: Lens' RegisterPublisherResponse (Maybe Text)
registerPublisherResponse_publisherId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPublisherResponse' {Maybe Text
publisherId :: Maybe Text
$sel:publisherId:RegisterPublisherResponse' :: RegisterPublisherResponse -> Maybe Text
publisherId} -> Maybe Text
publisherId) (\s :: RegisterPublisherResponse
s@RegisterPublisherResponse' {} Maybe Text
a -> RegisterPublisherResponse
s {$sel:publisherId:RegisterPublisherResponse' :: Maybe Text
publisherId = Maybe Text
a} :: RegisterPublisherResponse)

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

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