{-# 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.AddProfileKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a new key value with a specific profile, such as a Contact
-- Record ContactId.
--
-- A profile object can have a single unique key and any number of
-- additional keys that can be used to identify the profile that it belongs
-- to.
module Amazonka.CustomerProfiles.AddProfileKey
  ( -- * Creating a Request
    AddProfileKey (..),
    newAddProfileKey,

    -- * Request Lenses
    addProfileKey_profileId,
    addProfileKey_keyName,
    addProfileKey_values,
    addProfileKey_domainName,

    -- * Destructuring the Response
    AddProfileKeyResponse (..),
    newAddProfileKeyResponse,

    -- * Response Lenses
    addProfileKeyResponse_keyName,
    addProfileKeyResponse_values,
    addProfileKeyResponse_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:/ 'newAddProfileKey' smart constructor.
data AddProfileKey = AddProfileKey'
  { -- | The unique identifier of a customer profile.
    AddProfileKey -> Text
profileId :: Prelude.Text,
    -- | A searchable identifier of a customer profile. The predefined keys you
    -- can use include: _account, _profileId, _assetId, _caseId, _orderId,
    -- _fullName, _phone, _email, _ctrContactId, _marketoLeadId,
    -- _salesforceAccountId, _salesforceContactId, _salesforceAssetId,
    -- _zendeskUserId, _zendeskExternalId, _zendeskTicketId,
    -- _serviceNowSystemId, _serviceNowIncidentId, _segmentUserId,
    -- _shopifyCustomerId, _shopifyOrderId.
    AddProfileKey -> Text
keyName :: Prelude.Text,
    -- | A list of key values.
    AddProfileKey -> [Text]
values :: [Prelude.Text],
    -- | The unique name of the domain.
    AddProfileKey -> Text
domainName :: Prelude.Text
  }
  deriving (AddProfileKey -> AddProfileKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddProfileKey -> AddProfileKey -> Bool
$c/= :: AddProfileKey -> AddProfileKey -> Bool
== :: AddProfileKey -> AddProfileKey -> Bool
$c== :: AddProfileKey -> AddProfileKey -> Bool
Prelude.Eq, ReadPrec [AddProfileKey]
ReadPrec AddProfileKey
Int -> ReadS AddProfileKey
ReadS [AddProfileKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddProfileKey]
$creadListPrec :: ReadPrec [AddProfileKey]
readPrec :: ReadPrec AddProfileKey
$creadPrec :: ReadPrec AddProfileKey
readList :: ReadS [AddProfileKey]
$creadList :: ReadS [AddProfileKey]
readsPrec :: Int -> ReadS AddProfileKey
$creadsPrec :: Int -> ReadS AddProfileKey
Prelude.Read, Int -> AddProfileKey -> ShowS
[AddProfileKey] -> ShowS
AddProfileKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddProfileKey] -> ShowS
$cshowList :: [AddProfileKey] -> ShowS
show :: AddProfileKey -> String
$cshow :: AddProfileKey -> String
showsPrec :: Int -> AddProfileKey -> ShowS
$cshowsPrec :: Int -> AddProfileKey -> ShowS
Prelude.Show, forall x. Rep AddProfileKey x -> AddProfileKey
forall x. AddProfileKey -> Rep AddProfileKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddProfileKey x -> AddProfileKey
$cfrom :: forall x. AddProfileKey -> Rep AddProfileKey x
Prelude.Generic)

-- |
-- Create a value of 'AddProfileKey' 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', 'addProfileKey_profileId' - The unique identifier of a customer profile.
--
-- 'keyName', 'addProfileKey_keyName' - A searchable identifier of a customer profile. The predefined keys you
-- can use include: _account, _profileId, _assetId, _caseId, _orderId,
-- _fullName, _phone, _email, _ctrContactId, _marketoLeadId,
-- _salesforceAccountId, _salesforceContactId, _salesforceAssetId,
-- _zendeskUserId, _zendeskExternalId, _zendeskTicketId,
-- _serviceNowSystemId, _serviceNowIncidentId, _segmentUserId,
-- _shopifyCustomerId, _shopifyOrderId.
--
-- 'values', 'addProfileKey_values' - A list of key values.
--
-- 'domainName', 'addProfileKey_domainName' - The unique name of the domain.
newAddProfileKey ::
  -- | 'profileId'
  Prelude.Text ->
  -- | 'keyName'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  AddProfileKey
newAddProfileKey :: Text -> Text -> Text -> AddProfileKey
newAddProfileKey Text
pProfileId_ Text
pKeyName_ Text
pDomainName_ =
  AddProfileKey'
    { $sel:profileId:AddProfileKey' :: Text
profileId = Text
pProfileId_,
      $sel:keyName:AddProfileKey' :: Text
keyName = Text
pKeyName_,
      $sel:values:AddProfileKey' :: [Text]
values = forall a. Monoid a => a
Prelude.mempty,
      $sel:domainName:AddProfileKey' :: Text
domainName = Text
pDomainName_
    }

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

-- | A searchable identifier of a customer profile. The predefined keys you
-- can use include: _account, _profileId, _assetId, _caseId, _orderId,
-- _fullName, _phone, _email, _ctrContactId, _marketoLeadId,
-- _salesforceAccountId, _salesforceContactId, _salesforceAssetId,
-- _zendeskUserId, _zendeskExternalId, _zendeskTicketId,
-- _serviceNowSystemId, _serviceNowIncidentId, _segmentUserId,
-- _shopifyCustomerId, _shopifyOrderId.
addProfileKey_keyName :: Lens.Lens' AddProfileKey Prelude.Text
addProfileKey_keyName :: Lens' AddProfileKey Text
addProfileKey_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfileKey' {Text
keyName :: Text
$sel:keyName:AddProfileKey' :: AddProfileKey -> Text
keyName} -> Text
keyName) (\s :: AddProfileKey
s@AddProfileKey' {} Text
a -> AddProfileKey
s {$sel:keyName:AddProfileKey' :: Text
keyName = Text
a} :: AddProfileKey)

-- | A list of key values.
addProfileKey_values :: Lens.Lens' AddProfileKey [Prelude.Text]
addProfileKey_values :: Lens' AddProfileKey [Text]
addProfileKey_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfileKey' {[Text]
values :: [Text]
$sel:values:AddProfileKey' :: AddProfileKey -> [Text]
values} -> [Text]
values) (\s :: AddProfileKey
s@AddProfileKey' {} [Text]
a -> AddProfileKey
s {$sel:values:AddProfileKey' :: [Text]
values = [Text]
a} :: AddProfileKey) 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.
addProfileKey_domainName :: Lens.Lens' AddProfileKey Prelude.Text
addProfileKey_domainName :: Lens' AddProfileKey Text
addProfileKey_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfileKey' {Text
domainName :: Text
$sel:domainName:AddProfileKey' :: AddProfileKey -> Text
domainName} -> Text
domainName) (\s :: AddProfileKey
s@AddProfileKey' {} Text
a -> AddProfileKey
s {$sel:domainName:AddProfileKey' :: Text
domainName = Text
a} :: AddProfileKey)

instance Core.AWSRequest AddProfileKey where
  type
    AWSResponse AddProfileKey =
      AddProfileKeyResponse
  request :: (Service -> Service) -> AddProfileKey -> Request AddProfileKey
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 AddProfileKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddProfileKey)))
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 -> Maybe [Text] -> Int -> AddProfileKeyResponse
AddProfileKeyResponse'
            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
"KeyName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Values" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 AddProfileKey where
  hashWithSalt :: Int -> AddProfileKey -> Int
hashWithSalt Int
_salt AddProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:AddProfileKey' :: AddProfileKey -> Text
$sel:values:AddProfileKey' :: AddProfileKey -> [Text]
$sel:keyName:AddProfileKey' :: AddProfileKey -> Text
$sel:profileId:AddProfileKey' :: AddProfileKey -> 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 AddProfileKey where
  rnf :: AddProfileKey -> ()
rnf AddProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:AddProfileKey' :: AddProfileKey -> Text
$sel:values:AddProfileKey' :: AddProfileKey -> [Text]
$sel:keyName:AddProfileKey' :: AddProfileKey -> Text
$sel:profileId:AddProfileKey' :: AddProfileKey -> 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 AddProfileKey where
  toHeaders :: AddProfileKey -> 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 AddProfileKey where
  toJSON :: AddProfileKey -> Value
toJSON AddProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:AddProfileKey' :: AddProfileKey -> Text
$sel:values:AddProfileKey' :: AddProfileKey -> [Text]
$sel:keyName:AddProfileKey' :: AddProfileKey -> Text
$sel:profileId:AddProfileKey' :: AddProfileKey -> 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 AddProfileKey where
  toPath :: AddProfileKey -> ByteString
toPath AddProfileKey' {[Text]
Text
domainName :: Text
values :: [Text]
keyName :: Text
profileId :: Text
$sel:domainName:AddProfileKey' :: AddProfileKey -> Text
$sel:values:AddProfileKey' :: AddProfileKey -> [Text]
$sel:keyName:AddProfileKey' :: AddProfileKey -> Text
$sel:profileId:AddProfileKey' :: AddProfileKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName, ByteString
"/profiles/keys"]

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

-- | /See:/ 'newAddProfileKeyResponse' smart constructor.
data AddProfileKeyResponse = AddProfileKeyResponse'
  { -- | A searchable identifier of a customer profile.
    AddProfileKeyResponse -> Maybe Text
keyName :: Prelude.Maybe Prelude.Text,
    -- | A list of key values.
    AddProfileKeyResponse -> Maybe [Text]
values :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    AddProfileKeyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddProfileKeyResponse -> AddProfileKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddProfileKeyResponse -> AddProfileKeyResponse -> Bool
$c/= :: AddProfileKeyResponse -> AddProfileKeyResponse -> Bool
== :: AddProfileKeyResponse -> AddProfileKeyResponse -> Bool
$c== :: AddProfileKeyResponse -> AddProfileKeyResponse -> Bool
Prelude.Eq, ReadPrec [AddProfileKeyResponse]
ReadPrec AddProfileKeyResponse
Int -> ReadS AddProfileKeyResponse
ReadS [AddProfileKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddProfileKeyResponse]
$creadListPrec :: ReadPrec [AddProfileKeyResponse]
readPrec :: ReadPrec AddProfileKeyResponse
$creadPrec :: ReadPrec AddProfileKeyResponse
readList :: ReadS [AddProfileKeyResponse]
$creadList :: ReadS [AddProfileKeyResponse]
readsPrec :: Int -> ReadS AddProfileKeyResponse
$creadsPrec :: Int -> ReadS AddProfileKeyResponse
Prelude.Read, Int -> AddProfileKeyResponse -> ShowS
[AddProfileKeyResponse] -> ShowS
AddProfileKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddProfileKeyResponse] -> ShowS
$cshowList :: [AddProfileKeyResponse] -> ShowS
show :: AddProfileKeyResponse -> String
$cshow :: AddProfileKeyResponse -> String
showsPrec :: Int -> AddProfileKeyResponse -> ShowS
$cshowsPrec :: Int -> AddProfileKeyResponse -> ShowS
Prelude.Show, forall x. Rep AddProfileKeyResponse x -> AddProfileKeyResponse
forall x. AddProfileKeyResponse -> Rep AddProfileKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddProfileKeyResponse x -> AddProfileKeyResponse
$cfrom :: forall x. AddProfileKeyResponse -> Rep AddProfileKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddProfileKeyResponse' 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:
--
-- 'keyName', 'addProfileKeyResponse_keyName' - A searchable identifier of a customer profile.
--
-- 'values', 'addProfileKeyResponse_values' - A list of key values.
--
-- 'httpStatus', 'addProfileKeyResponse_httpStatus' - The response's http status code.
newAddProfileKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddProfileKeyResponse
newAddProfileKeyResponse :: Int -> AddProfileKeyResponse
newAddProfileKeyResponse Int
pHttpStatus_ =
  AddProfileKeyResponse'
    { $sel:keyName:AddProfileKeyResponse' :: Maybe Text
keyName = forall a. Maybe a
Prelude.Nothing,
      $sel:values:AddProfileKeyResponse' :: Maybe [Text]
values = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddProfileKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A list of key values.
addProfileKeyResponse_values :: Lens.Lens' AddProfileKeyResponse (Prelude.Maybe [Prelude.Text])
addProfileKeyResponse_values :: Lens' AddProfileKeyResponse (Maybe [Text])
addProfileKeyResponse_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfileKeyResponse' {Maybe [Text]
values :: Maybe [Text]
$sel:values:AddProfileKeyResponse' :: AddProfileKeyResponse -> Maybe [Text]
values} -> Maybe [Text]
values) (\s :: AddProfileKeyResponse
s@AddProfileKeyResponse' {} Maybe [Text]
a -> AddProfileKeyResponse
s {$sel:values:AddProfileKeyResponse' :: Maybe [Text]
values = Maybe [Text]
a} :: AddProfileKeyResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData AddProfileKeyResponse where
  rnf :: AddProfileKeyResponse -> ()
rnf AddProfileKeyResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
values :: Maybe [Text]
keyName :: Maybe Text
$sel:httpStatus:AddProfileKeyResponse' :: AddProfileKeyResponse -> Int
$sel:values:AddProfileKeyResponse' :: AddProfileKeyResponse -> Maybe [Text]
$sel:keyName:AddProfileKeyResponse' :: AddProfileKeyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
values
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus