{-# 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 #-}
module Amazonka.CognitoIdentityProvider.DeleteUserPoolDomain
(
DeleteUserPoolDomain (..),
newDeleteUserPoolDomain,
deleteUserPoolDomain_domain,
deleteUserPoolDomain_userPoolId,
DeleteUserPoolDomainResponse (..),
newDeleteUserPoolDomainResponse,
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
data DeleteUserPoolDomain = DeleteUserPoolDomain'
{
DeleteUserPoolDomain -> Text
domain :: Prelude.Text,
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)
newDeleteUserPoolDomain ::
Prelude.Text ->
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_
}
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)
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
data DeleteUserPoolDomainResponse = DeleteUserPoolDomainResponse'
{
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)
newDeleteUserPoolDomainResponse ::
Prelude.Int ->
DeleteUserPoolDomainResponse
newDeleteUserPoolDomainResponse :: Int -> DeleteUserPoolDomainResponse
newDeleteUserPoolDomainResponse Int
pHttpStatus_ =
DeleteUserPoolDomainResponse'
{ $sel:httpStatus:DeleteUserPoolDomainResponse' :: Int
httpStatus =
Int
pHttpStatus_
}
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