{-# 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.CustomerProfiles.DeleteProfileKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes a searchable key from a customer profile.
module Amazonka.CustomerProfiles.DeleteProfileKey
  ( -- * Creating a Request
    DeleteProfileKey (..),
    newDeleteProfileKey,

    -- * Request Lenses
    deleteProfileKey_profileId,
    deleteProfileKey_keyName,
    deleteProfileKey_values,
    deleteProfileKey_domainName,

    -- * Destructuring the Response
    DeleteProfileKeyResponse (..),
    newDeleteProfileKeyResponse,

    -- * Response Lenses
    deleteProfileKeyResponse_message,
    deleteProfileKeyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CustomerProfiles.Types
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:/ 'newDeleteProfileKey' smart constructor.
data DeleteProfileKey = DeleteProfileKey'
  { -- | The unique identifier of a customer profile.
    DeleteProfileKey -> Text
profileId :: Prelude.Text,
    -- | A searchable identifier of a customer profile.
    DeleteProfileKey -> Text
keyName :: Prelude.Text,
    -- | A list of key values.
    DeleteProfileKey -> [Text]
values :: [Prelude.Text],
    -- | The unique name of the domain.
    DeleteProfileKey -> Text
domainName :: Prelude.Text
  }
  deriving (DeleteProfileKey -> DeleteProfileKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteProfileKey -> DeleteProfileKey -> Bool
$c/= :: DeleteProfileKey -> DeleteProfileKey -> Bool
== :: DeleteProfileKey -> DeleteProfileKey -> Bool
$c== :: DeleteProfileKey -> DeleteProfileKey -> Bool
Prelude.Eq, ReadPrec [DeleteProfileKey]
ReadPrec DeleteProfileKey
Int -> ReadS DeleteProfileKey
ReadS [DeleteProfileKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteProfileKey]
$creadListPrec :: ReadPrec [DeleteProfileKey]
readPrec :: ReadPrec DeleteProfileKey
$creadPrec :: ReadPrec DeleteProfileKey
readList :: ReadS [DeleteProfileKey]
$creadList :: ReadS [DeleteProfileKey]
readsPrec :: Int -> ReadS DeleteProfileKey
$creadsPrec :: Int -> ReadS DeleteProfileKey
Prelude.Read, Int -> DeleteProfileKey -> ShowS
[DeleteProfileKey] -> ShowS
DeleteProfileKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteProfileKey] -> ShowS
$cshowList :: [DeleteProfileKey] -> ShowS
show :: DeleteProfileKey -> String
$cshow :: DeleteProfileKey -> String
showsPrec :: Int -> DeleteProfileKey -> ShowS
$cshowsPrec :: Int -> DeleteProfileKey -> ShowS
Prelude.Show, forall x. Rep DeleteProfileKey x -> DeleteProfileKey
forall x. DeleteProfileKey -> Rep DeleteProfileKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteProfileKey x -> DeleteProfileKey
$cfrom :: forall x. DeleteProfileKey -> Rep DeleteProfileKey x
Prelude.Generic)

-- |
-- Create a value of 'DeleteProfileKey' 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:
--
-- 'profileId', 'deleteProfileKey_profileId' - The unique identifier of a customer profile.
--
-- 'keyName', 'deleteProfileKey_keyName' - A searchable identifier of a customer profile.
--
-- 'values', 'deleteProfileKey_values' - A list of key values.
--
-- 'domainName', 'deleteProfileKey_domainName' - The unique name of the domain.
newDeleteProfileKey ::
  -- | 'profileId'
  Prelude.Text ->
  -- | 'keyName'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  DeleteProfileKey
newDeleteProfileKey :: Text -> Text -> Text -> DeleteProfileKey
newDeleteProfileKey
  Text
pProfileId_
  Text
pKeyName_
  Text
pDomainName_ =
    DeleteProfileKey'
      { $sel:profileId:DeleteProfileKey' :: Text
profileId = Text
pProfileId_,
        $sel:keyName:DeleteProfileKey' :: Text
keyName = Text
pKeyName_,
        $sel:values:DeleteProfileKey' :: [Text]
values = forall a. Monoid a => a
Prelude.mempty,
        $sel:domainName:DeleteProfileKey' :: Text
domainName = Text
pDomainName_
      }

-- | The unique identifier of a customer profile.
deleteProfileKey_profileId :: Lens.Lens' DeleteProfileKey Prelude.Text
deleteProfileKey_profileId :: Lens' DeleteProfileKey Text
deleteProfileKey_profileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProfileKey' {Text
profileId :: Text
$sel:profileId:DeleteProfileKey' :: DeleteProfileKey -> Text
profileId} -> Text
profileId) (\s :: DeleteProfileKey
s@DeleteProfileKey' {} Text
a -> DeleteProfileKey
s {$sel:profileId:DeleteProfileKey' :: Text
profileId = Text
a} :: DeleteProfileKey)

-- | A searchable identifier of a customer profile.
deleteProfileKey_keyName :: Lens.Lens' DeleteProfileKey Prelude.Text
deleteProfileKey_keyName :: Lens' DeleteProfileKey Text
deleteProfileKey_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProfileKey' {Text
keyName :: Text
$sel:keyName:DeleteProfileKey' :: DeleteProfileKey -> Text
keyName} -> Text
keyName) (\s :: DeleteProfileKey
s@DeleteProfileKey' {} Text
a -> DeleteProfileKey
s {$sel:keyName:DeleteProfileKey' :: Text
keyName = Text
a} :: DeleteProfileKey)

-- | A list of key values.
deleteProfileKey_values :: Lens.Lens' DeleteProfileKey [Prelude.Text]
deleteProfileKey_values :: Lens' DeleteProfileKey [Text]
deleteProfileKey_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProfileKey' {[Text]
values :: [Text]
$sel:values:DeleteProfileKey' :: DeleteProfileKey -> [Text]
values} -> [Text]
values) (\s :: DeleteProfileKey
s@DeleteProfileKey' {} [Text]
a -> DeleteProfileKey
s {$sel:values:DeleteProfileKey' :: [Text]
values = [Text]
a} :: DeleteProfileKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The unique name of the domain.
deleteProfileKey_domainName :: Lens.Lens' DeleteProfileKey Prelude.Text
deleteProfileKey_domainName :: Lens' DeleteProfileKey Text
deleteProfileKey_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProfileKey' {Text
domainName :: Text
$sel:domainName:DeleteProfileKey' :: DeleteProfileKey -> Text
domainName} -> Text
domainName) (\s :: DeleteProfileKey
s@DeleteProfileKey' {} Text
a -> DeleteProfileKey
s {$sel:domainName:DeleteProfileKey' :: Text
domainName = Text
a} :: DeleteProfileKey)

instance Core.AWSRequest DeleteProfileKey where
  type
    AWSResponse DeleteProfileKey =
      DeleteProfileKeyResponse
  request :: (Service -> Service)
-> DeleteProfileKey -> Request DeleteProfileKey
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 DeleteProfileKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteProfileKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> DeleteProfileKeyResponse
DeleteProfileKeyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Message")
            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 DeleteProfileKey where
  hashWithSalt :: Int -> DeleteProfileKey -> Int
hashWithSalt Int
_salt DeleteProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:values:DeleteProfileKey' :: DeleteProfileKey -> [Text]
$sel:keyName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:profileId:DeleteProfileKey' :: DeleteProfileKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
values
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData DeleteProfileKey where
  rnf :: DeleteProfileKey -> ()
rnf DeleteProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:values:DeleteProfileKey' :: DeleteProfileKey -> [Text]
$sel:keyName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:profileId:DeleteProfileKey' :: DeleteProfileKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
profileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
values
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

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

instance Data.ToJSON DeleteProfileKey where
  toJSON :: DeleteProfileKey -> Value
toJSON DeleteProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:values:DeleteProfileKey' :: DeleteProfileKey -> [Text]
$sel:keyName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:profileId:DeleteProfileKey' :: DeleteProfileKey -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
profileId),
            forall a. a -> Maybe a
Prelude.Just (Key
"KeyName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Values" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
values)
          ]
      )

instance Data.ToPath DeleteProfileKey where
  toPath :: DeleteProfileKey -> ByteString
toPath DeleteProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:values:DeleteProfileKey' :: DeleteProfileKey -> [Text]
$sel:keyName:DeleteProfileKey' :: DeleteProfileKey -> Text
$sel:profileId:DeleteProfileKey' :: DeleteProfileKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/profiles/keys/delete"
      ]

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

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

-- |
-- Create a value of 'DeleteProfileKeyResponse' 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:
--
-- 'message', 'deleteProfileKeyResponse_message' - A message that indicates the delete request is done.
--
-- 'httpStatus', 'deleteProfileKeyResponse_httpStatus' - The response's http status code.
newDeleteProfileKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteProfileKeyResponse
newDeleteProfileKeyResponse :: Int -> DeleteProfileKeyResponse
newDeleteProfileKeyResponse Int
pHttpStatus_ =
  DeleteProfileKeyResponse'
    { $sel:message:DeleteProfileKeyResponse' :: Maybe Text
message =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteProfileKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A message that indicates the delete request is done.
deleteProfileKeyResponse_message :: Lens.Lens' DeleteProfileKeyResponse (Prelude.Maybe Prelude.Text)
deleteProfileKeyResponse_message :: Lens' DeleteProfileKeyResponse (Maybe Text)
deleteProfileKeyResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProfileKeyResponse' {Maybe Text
message :: Maybe Text
$sel:message:DeleteProfileKeyResponse' :: DeleteProfileKeyResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: DeleteProfileKeyResponse
s@DeleteProfileKeyResponse' {} Maybe Text
a -> DeleteProfileKeyResponse
s {$sel:message:DeleteProfileKeyResponse' :: Maybe Text
message = Maybe Text
a} :: DeleteProfileKeyResponse)

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

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