{-# 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.CognitoIdentityProvider.DeleteUserPoolDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a domain for a user pool.
module Amazonka.CognitoIdentityProvider.DeleteUserPoolDomain
  ( -- * Creating a Request
    DeleteUserPoolDomain (..),
    newDeleteUserPoolDomain,

    -- * Request Lenses
    deleteUserPoolDomain_domain,
    deleteUserPoolDomain_userPoolId,

    -- * Destructuring the Response
    DeleteUserPoolDomainResponse (..),
    newDeleteUserPoolDomainResponse,

    -- * Response Lenses
    deleteUserPoolDomainResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.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:/ 'newDeleteUserPoolDomain' smart constructor.
data DeleteUserPoolDomain = DeleteUserPoolDomain'
  { -- | The domain string. For custom domains, this is the fully-qualified
    -- domain name, such as @auth.example.com@. For Amazon Cognito prefix
    -- domains, this is the prefix alone, such as @auth@.
    DeleteUserPoolDomain -> Text
domain :: Prelude.Text,
    -- | The user pool ID.
    DeleteUserPoolDomain -> Text
userPoolId :: Prelude.Text
  }
  deriving (DeleteUserPoolDomain -> DeleteUserPoolDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteUserPoolDomain -> DeleteUserPoolDomain -> Bool
$c/= :: DeleteUserPoolDomain -> DeleteUserPoolDomain -> Bool
== :: DeleteUserPoolDomain -> DeleteUserPoolDomain -> Bool
$c== :: DeleteUserPoolDomain -> DeleteUserPoolDomain -> Bool
Prelude.Eq, ReadPrec [DeleteUserPoolDomain]
ReadPrec DeleteUserPoolDomain
Int -> ReadS DeleteUserPoolDomain
ReadS [DeleteUserPoolDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteUserPoolDomain]
$creadListPrec :: ReadPrec [DeleteUserPoolDomain]
readPrec :: ReadPrec DeleteUserPoolDomain
$creadPrec :: ReadPrec DeleteUserPoolDomain
readList :: ReadS [DeleteUserPoolDomain]
$creadList :: ReadS [DeleteUserPoolDomain]
readsPrec :: Int -> ReadS DeleteUserPoolDomain
$creadsPrec :: Int -> ReadS DeleteUserPoolDomain
Prelude.Read, Int -> DeleteUserPoolDomain -> ShowS
[DeleteUserPoolDomain] -> ShowS
DeleteUserPoolDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteUserPoolDomain] -> ShowS
$cshowList :: [DeleteUserPoolDomain] -> ShowS
show :: DeleteUserPoolDomain -> String
$cshow :: DeleteUserPoolDomain -> String
showsPrec :: Int -> DeleteUserPoolDomain -> ShowS
$cshowsPrec :: Int -> DeleteUserPoolDomain -> ShowS
Prelude.Show, forall x. Rep DeleteUserPoolDomain x -> DeleteUserPoolDomain
forall x. DeleteUserPoolDomain -> Rep DeleteUserPoolDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteUserPoolDomain x -> DeleteUserPoolDomain
$cfrom :: forall x. DeleteUserPoolDomain -> Rep DeleteUserPoolDomain x
Prelude.Generic)

-- |
-- Create a value of 'DeleteUserPoolDomain' 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:
--
-- 'domain', 'deleteUserPoolDomain_domain' - The domain string. For custom domains, this is the fully-qualified
-- domain name, such as @auth.example.com@. For Amazon Cognito prefix
-- domains, this is the prefix alone, such as @auth@.
--
-- 'userPoolId', 'deleteUserPoolDomain_userPoolId' - The user pool ID.
newDeleteUserPoolDomain ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'userPoolId'
  Prelude.Text ->
  DeleteUserPoolDomain
newDeleteUserPoolDomain :: Text -> Text -> DeleteUserPoolDomain
newDeleteUserPoolDomain Text
pDomain_ Text
pUserPoolId_ =
  DeleteUserPoolDomain'
    { $sel:domain:DeleteUserPoolDomain' :: Text
domain = Text
pDomain_,
      $sel:userPoolId:DeleteUserPoolDomain' :: Text
userPoolId = Text
pUserPoolId_
    }

-- | The domain string. For custom domains, this is the fully-qualified
-- domain name, such as @auth.example.com@. For Amazon Cognito prefix
-- domains, this is the prefix alone, such as @auth@.
deleteUserPoolDomain_domain :: Lens.Lens' DeleteUserPoolDomain Prelude.Text
deleteUserPoolDomain_domain :: Lens' DeleteUserPoolDomain Text
deleteUserPoolDomain_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUserPoolDomain' {Text
domain :: Text
$sel:domain:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
domain} -> Text
domain) (\s :: DeleteUserPoolDomain
s@DeleteUserPoolDomain' {} Text
a -> DeleteUserPoolDomain
s {$sel:domain:DeleteUserPoolDomain' :: Text
domain = Text
a} :: DeleteUserPoolDomain)

-- | The user pool ID.
deleteUserPoolDomain_userPoolId :: Lens.Lens' DeleteUserPoolDomain Prelude.Text
deleteUserPoolDomain_userPoolId :: Lens' DeleteUserPoolDomain Text
deleteUserPoolDomain_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUserPoolDomain' {Text
userPoolId :: Text
$sel:userPoolId:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
userPoolId} -> Text
userPoolId) (\s :: DeleteUserPoolDomain
s@DeleteUserPoolDomain' {} Text
a -> DeleteUserPoolDomain
s {$sel:userPoolId:DeleteUserPoolDomain' :: Text
userPoolId = Text
a} :: DeleteUserPoolDomain)

instance Core.AWSRequest DeleteUserPoolDomain where
  type
    AWSResponse DeleteUserPoolDomain =
      DeleteUserPoolDomainResponse
  request :: (Service -> Service)
-> DeleteUserPoolDomain -> Request DeleteUserPoolDomain
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteUserPoolDomain
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteUserPoolDomain)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteUserPoolDomainResponse
DeleteUserPoolDomainResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteUserPoolDomain where
  hashWithSalt :: Int -> DeleteUserPoolDomain -> Int
hashWithSalt Int
_salt DeleteUserPoolDomain' {Text
userPoolId :: Text
domain :: Text
$sel:userPoolId:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
$sel:domain:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData DeleteUserPoolDomain where
  rnf :: DeleteUserPoolDomain -> ()
rnf DeleteUserPoolDomain' {Text
userPoolId :: Text
domain :: Text
$sel:userPoolId:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
$sel:domain:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

instance Data.ToHeaders DeleteUserPoolDomain where
  toHeaders :: DeleteUserPoolDomain -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSCognitoIdentityProviderService.DeleteUserPoolDomain" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteUserPoolDomain where
  toJSON :: DeleteUserPoolDomain -> Value
toJSON DeleteUserPoolDomain' {Text
userPoolId :: Text
domain :: Text
$sel:userPoolId:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
$sel:domain:DeleteUserPoolDomain' :: DeleteUserPoolDomain -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domain),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId)
          ]
      )

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

instance Data.ToQuery DeleteUserPoolDomain where
  toQuery :: DeleteUserPoolDomain -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'DeleteUserPoolDomainResponse' 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:
--
-- 'httpStatus', 'deleteUserPoolDomainResponse_httpStatus' - The response's http status code.
newDeleteUserPoolDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteUserPoolDomainResponse
newDeleteUserPoolDomainResponse :: Int -> DeleteUserPoolDomainResponse
newDeleteUserPoolDomainResponse Int
pHttpStatus_ =
  DeleteUserPoolDomainResponse'
    { $sel:httpStatus:DeleteUserPoolDomainResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData DeleteUserPoolDomainResponse where
  rnf :: DeleteUserPoolDomainResponse -> ()
rnf DeleteUserPoolDomainResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteUserPoolDomainResponse' :: DeleteUserPoolDomainResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus