{-# 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.MergeProfiles
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Runs an AWS Lambda job that does the following:
--
-- 1.  All the profileKeys in the @ProfileToBeMerged@ will be moved to the
--     main profile.
--
-- 2.  All the objects in the @ProfileToBeMerged@ will be moved to the main
--     profile.
--
-- 3.  All the @ProfileToBeMerged@ will be deleted at the end.
--
-- 4.  All the profileKeys in the @ProfileIdsToBeMerged@ will be moved to
--     the main profile.
--
-- 5.  Standard fields are merged as follows:
--
--     1.  Fields are always \"union\"-ed if there are no conflicts in
--         standard fields or attributeKeys.
--
--     2.  When there are conflicting fields:
--
--         1.  If no @SourceProfileIds@ entry is specified, the main
--             Profile value is always taken.
--
--         2.  If a @SourceProfileIds@ entry is specified, the specified
--             profileId is always taken, even if it is a NULL value.
--
-- You can use MergeProfiles together with
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_GetMatches.html GetMatches>,
-- which returns potentially matching profiles, or use it with the results
-- of another matching system. After profiles have been merged, they cannot
-- be separated (unmerged).
module Amazonka.CustomerProfiles.MergeProfiles
  ( -- * Creating a Request
    MergeProfiles (..),
    newMergeProfiles,

    -- * Request Lenses
    mergeProfiles_fieldSourceProfileIds,
    mergeProfiles_domainName,
    mergeProfiles_mainProfileId,
    mergeProfiles_profileIdsToBeMerged,

    -- * Destructuring the Response
    MergeProfilesResponse (..),
    newMergeProfilesResponse,

    -- * Response Lenses
    mergeProfilesResponse_message,
    mergeProfilesResponse_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:/ 'newMergeProfiles' smart constructor.
data MergeProfiles = MergeProfiles'
  { -- | The identifiers of the fields in the profile that has the information
    -- you want to apply to the merge. For example, say you want to merge
    -- EmailAddress from Profile1 into MainProfile. This would be the
    -- identifier of the EmailAddress field in Profile1.
    MergeProfiles -> Maybe FieldSourceProfileIds
fieldSourceProfileIds :: Prelude.Maybe FieldSourceProfileIds,
    -- | The unique name of the domain.
    MergeProfiles -> Text
domainName :: Prelude.Text,
    -- | The identifier of the profile to be taken.
    MergeProfiles -> Text
mainProfileId :: Prelude.Text,
    -- | The identifier of the profile to be merged into MainProfileId.
    MergeProfiles -> NonEmpty Text
profileIdsToBeMerged :: Prelude.NonEmpty Prelude.Text
  }
  deriving (MergeProfiles -> MergeProfiles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeProfiles -> MergeProfiles -> Bool
$c/= :: MergeProfiles -> MergeProfiles -> Bool
== :: MergeProfiles -> MergeProfiles -> Bool
$c== :: MergeProfiles -> MergeProfiles -> Bool
Prelude.Eq, ReadPrec [MergeProfiles]
ReadPrec MergeProfiles
Int -> ReadS MergeProfiles
ReadS [MergeProfiles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MergeProfiles]
$creadListPrec :: ReadPrec [MergeProfiles]
readPrec :: ReadPrec MergeProfiles
$creadPrec :: ReadPrec MergeProfiles
readList :: ReadS [MergeProfiles]
$creadList :: ReadS [MergeProfiles]
readsPrec :: Int -> ReadS MergeProfiles
$creadsPrec :: Int -> ReadS MergeProfiles
Prelude.Read, Int -> MergeProfiles -> ShowS
[MergeProfiles] -> ShowS
MergeProfiles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeProfiles] -> ShowS
$cshowList :: [MergeProfiles] -> ShowS
show :: MergeProfiles -> String
$cshow :: MergeProfiles -> String
showsPrec :: Int -> MergeProfiles -> ShowS
$cshowsPrec :: Int -> MergeProfiles -> ShowS
Prelude.Show, forall x. Rep MergeProfiles x -> MergeProfiles
forall x. MergeProfiles -> Rep MergeProfiles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeProfiles x -> MergeProfiles
$cfrom :: forall x. MergeProfiles -> Rep MergeProfiles x
Prelude.Generic)

-- |
-- Create a value of 'MergeProfiles' 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:
--
-- 'fieldSourceProfileIds', 'mergeProfiles_fieldSourceProfileIds' - The identifiers of the fields in the profile that has the information
-- you want to apply to the merge. For example, say you want to merge
-- EmailAddress from Profile1 into MainProfile. This would be the
-- identifier of the EmailAddress field in Profile1.
--
-- 'domainName', 'mergeProfiles_domainName' - The unique name of the domain.
--
-- 'mainProfileId', 'mergeProfiles_mainProfileId' - The identifier of the profile to be taken.
--
-- 'profileIdsToBeMerged', 'mergeProfiles_profileIdsToBeMerged' - The identifier of the profile to be merged into MainProfileId.
newMergeProfiles ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'mainProfileId'
  Prelude.Text ->
  -- | 'profileIdsToBeMerged'
  Prelude.NonEmpty Prelude.Text ->
  MergeProfiles
newMergeProfiles :: Text -> Text -> NonEmpty Text -> MergeProfiles
newMergeProfiles
  Text
pDomainName_
  Text
pMainProfileId_
  NonEmpty Text
pProfileIdsToBeMerged_ =
    MergeProfiles'
      { $sel:fieldSourceProfileIds:MergeProfiles' :: Maybe FieldSourceProfileIds
fieldSourceProfileIds =
          forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:MergeProfiles' :: Text
domainName = Text
pDomainName_,
        $sel:mainProfileId:MergeProfiles' :: Text
mainProfileId = Text
pMainProfileId_,
        $sel:profileIdsToBeMerged:MergeProfiles' :: NonEmpty Text
profileIdsToBeMerged =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pProfileIdsToBeMerged_
      }

-- | The identifiers of the fields in the profile that has the information
-- you want to apply to the merge. For example, say you want to merge
-- EmailAddress from Profile1 into MainProfile. This would be the
-- identifier of the EmailAddress field in Profile1.
mergeProfiles_fieldSourceProfileIds :: Lens.Lens' MergeProfiles (Prelude.Maybe FieldSourceProfileIds)
mergeProfiles_fieldSourceProfileIds :: Lens' MergeProfiles (Maybe FieldSourceProfileIds)
mergeProfiles_fieldSourceProfileIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergeProfiles' {Maybe FieldSourceProfileIds
fieldSourceProfileIds :: Maybe FieldSourceProfileIds
$sel:fieldSourceProfileIds:MergeProfiles' :: MergeProfiles -> Maybe FieldSourceProfileIds
fieldSourceProfileIds} -> Maybe FieldSourceProfileIds
fieldSourceProfileIds) (\s :: MergeProfiles
s@MergeProfiles' {} Maybe FieldSourceProfileIds
a -> MergeProfiles
s {$sel:fieldSourceProfileIds:MergeProfiles' :: Maybe FieldSourceProfileIds
fieldSourceProfileIds = Maybe FieldSourceProfileIds
a} :: MergeProfiles)

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

-- | The identifier of the profile to be taken.
mergeProfiles_mainProfileId :: Lens.Lens' MergeProfiles Prelude.Text
mergeProfiles_mainProfileId :: Lens' MergeProfiles Text
mergeProfiles_mainProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergeProfiles' {Text
mainProfileId :: Text
$sel:mainProfileId:MergeProfiles' :: MergeProfiles -> Text
mainProfileId} -> Text
mainProfileId) (\s :: MergeProfiles
s@MergeProfiles' {} Text
a -> MergeProfiles
s {$sel:mainProfileId:MergeProfiles' :: Text
mainProfileId = Text
a} :: MergeProfiles)

-- | The identifier of the profile to be merged into MainProfileId.
mergeProfiles_profileIdsToBeMerged :: Lens.Lens' MergeProfiles (Prelude.NonEmpty Prelude.Text)
mergeProfiles_profileIdsToBeMerged :: Lens' MergeProfiles (NonEmpty Text)
mergeProfiles_profileIdsToBeMerged = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergeProfiles' {NonEmpty Text
profileIdsToBeMerged :: NonEmpty Text
$sel:profileIdsToBeMerged:MergeProfiles' :: MergeProfiles -> NonEmpty Text
profileIdsToBeMerged} -> NonEmpty Text
profileIdsToBeMerged) (\s :: MergeProfiles
s@MergeProfiles' {} NonEmpty Text
a -> MergeProfiles
s {$sel:profileIdsToBeMerged:MergeProfiles' :: NonEmpty Text
profileIdsToBeMerged = NonEmpty Text
a} :: MergeProfiles) 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

instance Core.AWSRequest MergeProfiles where
  type
    AWSResponse MergeProfiles =
      MergeProfilesResponse
  request :: (Service -> Service) -> MergeProfiles -> Request MergeProfiles
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 MergeProfiles
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MergeProfiles)))
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 -> MergeProfilesResponse
MergeProfilesResponse'
            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 MergeProfiles where
  hashWithSalt :: Int -> MergeProfiles -> Int
hashWithSalt Int
_salt MergeProfiles' {Maybe FieldSourceProfileIds
NonEmpty Text
Text
profileIdsToBeMerged :: NonEmpty Text
mainProfileId :: Text
domainName :: Text
fieldSourceProfileIds :: Maybe FieldSourceProfileIds
$sel:profileIdsToBeMerged:MergeProfiles' :: MergeProfiles -> NonEmpty Text
$sel:mainProfileId:MergeProfiles' :: MergeProfiles -> Text
$sel:domainName:MergeProfiles' :: MergeProfiles -> Text
$sel:fieldSourceProfileIds:MergeProfiles' :: MergeProfiles -> Maybe FieldSourceProfileIds
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FieldSourceProfileIds
fieldSourceProfileIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mainProfileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
profileIdsToBeMerged

instance Prelude.NFData MergeProfiles where
  rnf :: MergeProfiles -> ()
rnf MergeProfiles' {Maybe FieldSourceProfileIds
NonEmpty Text
Text
profileIdsToBeMerged :: NonEmpty Text
mainProfileId :: Text
domainName :: Text
fieldSourceProfileIds :: Maybe FieldSourceProfileIds
$sel:profileIdsToBeMerged:MergeProfiles' :: MergeProfiles -> NonEmpty Text
$sel:mainProfileId:MergeProfiles' :: MergeProfiles -> Text
$sel:domainName:MergeProfiles' :: MergeProfiles -> Text
$sel:fieldSourceProfileIds:MergeProfiles' :: MergeProfiles -> Maybe FieldSourceProfileIds
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FieldSourceProfileIds
fieldSourceProfileIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mainProfileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
profileIdsToBeMerged

instance Data.ToHeaders MergeProfiles where
  toHeaders :: MergeProfiles -> 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 MergeProfiles where
  toJSON :: MergeProfiles -> Value
toJSON MergeProfiles' {Maybe FieldSourceProfileIds
NonEmpty Text
Text
profileIdsToBeMerged :: NonEmpty Text
mainProfileId :: Text
domainName :: Text
fieldSourceProfileIds :: Maybe FieldSourceProfileIds
$sel:profileIdsToBeMerged:MergeProfiles' :: MergeProfiles -> NonEmpty Text
$sel:mainProfileId:MergeProfiles' :: MergeProfiles -> Text
$sel:domainName:MergeProfiles' :: MergeProfiles -> Text
$sel:fieldSourceProfileIds:MergeProfiles' :: MergeProfiles -> Maybe FieldSourceProfileIds
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FieldSourceProfileIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FieldSourceProfileIds
fieldSourceProfileIds,
            forall a. a -> Maybe a
Prelude.Just (Key
"MainProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mainProfileId),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ProfileIdsToBeMerged"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
profileIdsToBeMerged
              )
          ]
      )

instance Data.ToPath MergeProfiles where
  toPath :: MergeProfiles -> ByteString
toPath MergeProfiles' {Maybe FieldSourceProfileIds
NonEmpty Text
Text
profileIdsToBeMerged :: NonEmpty Text
mainProfileId :: Text
domainName :: Text
fieldSourceProfileIds :: Maybe FieldSourceProfileIds
$sel:profileIdsToBeMerged:MergeProfiles' :: MergeProfiles -> NonEmpty Text
$sel:mainProfileId:MergeProfiles' :: MergeProfiles -> Text
$sel:domainName:MergeProfiles' :: MergeProfiles -> Text
$sel:fieldSourceProfileIds:MergeProfiles' :: MergeProfiles -> Maybe FieldSourceProfileIds
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/profiles/objects/merge"
      ]

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

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

-- |
-- Create a value of 'MergeProfilesResponse' 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', 'mergeProfilesResponse_message' - A message that indicates the merge request is complete.
--
-- 'httpStatus', 'mergeProfilesResponse_httpStatus' - The response's http status code.
newMergeProfilesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MergeProfilesResponse
newMergeProfilesResponse :: Int -> MergeProfilesResponse
newMergeProfilesResponse Int
pHttpStatus_ =
  MergeProfilesResponse'
    { $sel:message:MergeProfilesResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MergeProfilesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData MergeProfilesResponse where
  rnf :: MergeProfilesResponse -> ()
rnf MergeProfilesResponse' {Int
Maybe Text
httpStatus :: Int
message :: Maybe Text
$sel:httpStatus:MergeProfilesResponse' :: MergeProfilesResponse -> Int
$sel:message:MergeProfilesResponse' :: MergeProfilesResponse -> 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