{-# 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.GetIdentityResolutionJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about an Identity Resolution Job in a specific
-- domain.
--
-- Identity Resolution Jobs are set up using the Amazon Connect admin
-- console. For more information, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/use-identity-resolution.html Use Identity Resolution to consolidate similar profiles>.
module Amazonka.CustomerProfiles.GetIdentityResolutionJob
  ( -- * Creating a Request
    GetIdentityResolutionJob (..),
    newGetIdentityResolutionJob,

    -- * Request Lenses
    getIdentityResolutionJob_domainName,
    getIdentityResolutionJob_jobId,

    -- * Destructuring the Response
    GetIdentityResolutionJobResponse (..),
    newGetIdentityResolutionJobResponse,

    -- * Response Lenses
    getIdentityResolutionJobResponse_autoMerging,
    getIdentityResolutionJobResponse_domainName,
    getIdentityResolutionJobResponse_exportingLocation,
    getIdentityResolutionJobResponse_jobEndTime,
    getIdentityResolutionJobResponse_jobExpirationTime,
    getIdentityResolutionJobResponse_jobId,
    getIdentityResolutionJobResponse_jobStartTime,
    getIdentityResolutionJobResponse_jobStats,
    getIdentityResolutionJobResponse_lastUpdatedAt,
    getIdentityResolutionJobResponse_message,
    getIdentityResolutionJobResponse_status,
    getIdentityResolutionJobResponse_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:/ 'newGetIdentityResolutionJob' smart constructor.
data GetIdentityResolutionJob = GetIdentityResolutionJob'
  { -- | The unique name of the domain.
    GetIdentityResolutionJob -> Text
domainName :: Prelude.Text,
    -- | The unique identifier of the Identity Resolution Job.
    GetIdentityResolutionJob -> Text
jobId :: Prelude.Text
  }
  deriving (GetIdentityResolutionJob -> GetIdentityResolutionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityResolutionJob -> GetIdentityResolutionJob -> Bool
$c/= :: GetIdentityResolutionJob -> GetIdentityResolutionJob -> Bool
== :: GetIdentityResolutionJob -> GetIdentityResolutionJob -> Bool
$c== :: GetIdentityResolutionJob -> GetIdentityResolutionJob -> Bool
Prelude.Eq, ReadPrec [GetIdentityResolutionJob]
ReadPrec GetIdentityResolutionJob
Int -> ReadS GetIdentityResolutionJob
ReadS [GetIdentityResolutionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityResolutionJob]
$creadListPrec :: ReadPrec [GetIdentityResolutionJob]
readPrec :: ReadPrec GetIdentityResolutionJob
$creadPrec :: ReadPrec GetIdentityResolutionJob
readList :: ReadS [GetIdentityResolutionJob]
$creadList :: ReadS [GetIdentityResolutionJob]
readsPrec :: Int -> ReadS GetIdentityResolutionJob
$creadsPrec :: Int -> ReadS GetIdentityResolutionJob
Prelude.Read, Int -> GetIdentityResolutionJob -> ShowS
[GetIdentityResolutionJob] -> ShowS
GetIdentityResolutionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityResolutionJob] -> ShowS
$cshowList :: [GetIdentityResolutionJob] -> ShowS
show :: GetIdentityResolutionJob -> String
$cshow :: GetIdentityResolutionJob -> String
showsPrec :: Int -> GetIdentityResolutionJob -> ShowS
$cshowsPrec :: Int -> GetIdentityResolutionJob -> ShowS
Prelude.Show, forall x.
Rep GetIdentityResolutionJob x -> GetIdentityResolutionJob
forall x.
GetIdentityResolutionJob -> Rep GetIdentityResolutionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIdentityResolutionJob x -> GetIdentityResolutionJob
$cfrom :: forall x.
GetIdentityResolutionJob -> Rep GetIdentityResolutionJob x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityResolutionJob' 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:
--
-- 'domainName', 'getIdentityResolutionJob_domainName' - The unique name of the domain.
--
-- 'jobId', 'getIdentityResolutionJob_jobId' - The unique identifier of the Identity Resolution Job.
newGetIdentityResolutionJob ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  GetIdentityResolutionJob
newGetIdentityResolutionJob :: Text -> Text -> GetIdentityResolutionJob
newGetIdentityResolutionJob Text
pDomainName_ Text
pJobId_ =
  GetIdentityResolutionJob'
    { $sel:domainName:GetIdentityResolutionJob' :: Text
domainName =
        Text
pDomainName_,
      $sel:jobId:GetIdentityResolutionJob' :: Text
jobId = Text
pJobId_
    }

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

-- | The unique identifier of the Identity Resolution Job.
getIdentityResolutionJob_jobId :: Lens.Lens' GetIdentityResolutionJob Prelude.Text
getIdentityResolutionJob_jobId :: Lens' GetIdentityResolutionJob Text
getIdentityResolutionJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJob' {Text
jobId :: Text
$sel:jobId:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
jobId} -> Text
jobId) (\s :: GetIdentityResolutionJob
s@GetIdentityResolutionJob' {} Text
a -> GetIdentityResolutionJob
s {$sel:jobId:GetIdentityResolutionJob' :: Text
jobId = Text
a} :: GetIdentityResolutionJob)

instance Core.AWSRequest GetIdentityResolutionJob where
  type
    AWSResponse GetIdentityResolutionJob =
      GetIdentityResolutionJobResponse
  request :: (Service -> Service)
-> GetIdentityResolutionJob -> Request GetIdentityResolutionJob
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetIdentityResolutionJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetIdentityResolutionJob)))
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 AutoMerging
-> Maybe Text
-> Maybe ExportingLocation
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe JobStats
-> Maybe POSIX
-> Maybe Text
-> Maybe IdentityResolutionJobStatus
-> Int
-> GetIdentityResolutionJobResponse
GetIdentityResolutionJobResponse'
            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
"AutoMerging")
            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
"DomainName")
            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
"ExportingLocation")
            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
"JobEndTime")
            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
"JobExpirationTime")
            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
"JobId")
            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
"JobStartTime")
            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
"JobStats")
            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
"LastUpdatedAt")
            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
"Message")
            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
"Status")
            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 GetIdentityResolutionJob where
  hashWithSalt :: Int -> GetIdentityResolutionJob -> Int
hashWithSalt Int
_salt GetIdentityResolutionJob' {Text
jobId :: Text
domainName :: Text
$sel:jobId:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
$sel:domainName:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData GetIdentityResolutionJob where
  rnf :: GetIdentityResolutionJob -> ()
rnf GetIdentityResolutionJob' {Text
jobId :: Text
domainName :: Text
$sel:jobId:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
$sel:domainName:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
..} =
    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
jobId

instance Data.ToHeaders GetIdentityResolutionJob where
  toHeaders :: GetIdentityResolutionJob -> 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.ToPath GetIdentityResolutionJob where
  toPath :: GetIdentityResolutionJob -> ByteString
toPath GetIdentityResolutionJob' {Text
jobId :: Text
domainName :: Text
$sel:jobId:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
$sel:domainName:GetIdentityResolutionJob' :: GetIdentityResolutionJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/identity-resolution-jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId
      ]

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

-- | /See:/ 'newGetIdentityResolutionJobResponse' smart constructor.
data GetIdentityResolutionJobResponse = GetIdentityResolutionJobResponse'
  { -- | Configuration settings for how to perform the auto-merging of profiles.
    GetIdentityResolutionJobResponse -> Maybe AutoMerging
autoMerging :: Prelude.Maybe AutoMerging,
    -- | The unique name of the domain.
    GetIdentityResolutionJobResponse -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The S3 location where the Identity Resolution Job writes result files.
    GetIdentityResolutionJobResponse -> Maybe ExportingLocation
exportingLocation :: Prelude.Maybe ExportingLocation,
    -- | The timestamp of when the Identity Resolution Job was completed.
    GetIdentityResolutionJobResponse -> Maybe POSIX
jobEndTime :: Prelude.Maybe Data.POSIX,
    -- | The timestamp of when the Identity Resolution Job will expire.
    GetIdentityResolutionJobResponse -> Maybe POSIX
jobExpirationTime :: Prelude.Maybe Data.POSIX,
    -- | The unique identifier of the Identity Resolution Job.
    GetIdentityResolutionJobResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The timestamp of when the Identity Resolution Job was started or will be
    -- started.
    GetIdentityResolutionJobResponse -> Maybe POSIX
jobStartTime :: Prelude.Maybe Data.POSIX,
    -- | Statistics about the Identity Resolution Job.
    GetIdentityResolutionJobResponse -> Maybe JobStats
jobStats :: Prelude.Maybe JobStats,
    -- | The timestamp of when the Identity Resolution Job was most recently
    -- edited.
    GetIdentityResolutionJobResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | The error messages that are generated when the Identity Resolution Job
    -- runs.
    GetIdentityResolutionJobResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The status of the Identity Resolution Job.
    --
    -- -   @PENDING@: The Identity Resolution Job is scheduled but has not
    --     started yet. If you turn off the Identity Resolution feature in your
    --     domain, jobs in the @PENDING@ state are deleted.
    --
    -- -   @PREPROCESSING@: The Identity Resolution Job is loading your data.
    --
    -- -   @FIND_MATCHING@: The Identity Resolution Job is using the machine
    --     learning model to identify profiles that belong to the same matching
    --     group.
    --
    -- -   @MERGING@: The Identity Resolution Job is merging duplicate
    --     profiles.
    --
    -- -   @COMPLETED@: The Identity Resolution Job completed successfully.
    --
    -- -   @PARTIAL_SUCCESS@: There\'s a system error and not all of the data
    --     is merged. The Identity Resolution Job writes a message indicating
    --     the source of the problem.
    --
    -- -   @FAILED@: The Identity Resolution Job did not merge any data. It
    --     writes a message indicating the source of the problem.
    GetIdentityResolutionJobResponse
-> Maybe IdentityResolutionJobStatus
status :: Prelude.Maybe IdentityResolutionJobStatus,
    -- | The response's http status code.
    GetIdentityResolutionJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetIdentityResolutionJobResponse
-> GetIdentityResolutionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdentityResolutionJobResponse
-> GetIdentityResolutionJobResponse -> Bool
$c/= :: GetIdentityResolutionJobResponse
-> GetIdentityResolutionJobResponse -> Bool
== :: GetIdentityResolutionJobResponse
-> GetIdentityResolutionJobResponse -> Bool
$c== :: GetIdentityResolutionJobResponse
-> GetIdentityResolutionJobResponse -> Bool
Prelude.Eq, ReadPrec [GetIdentityResolutionJobResponse]
ReadPrec GetIdentityResolutionJobResponse
Int -> ReadS GetIdentityResolutionJobResponse
ReadS [GetIdentityResolutionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdentityResolutionJobResponse]
$creadListPrec :: ReadPrec [GetIdentityResolutionJobResponse]
readPrec :: ReadPrec GetIdentityResolutionJobResponse
$creadPrec :: ReadPrec GetIdentityResolutionJobResponse
readList :: ReadS [GetIdentityResolutionJobResponse]
$creadList :: ReadS [GetIdentityResolutionJobResponse]
readsPrec :: Int -> ReadS GetIdentityResolutionJobResponse
$creadsPrec :: Int -> ReadS GetIdentityResolutionJobResponse
Prelude.Read, Int -> GetIdentityResolutionJobResponse -> ShowS
[GetIdentityResolutionJobResponse] -> ShowS
GetIdentityResolutionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdentityResolutionJobResponse] -> ShowS
$cshowList :: [GetIdentityResolutionJobResponse] -> ShowS
show :: GetIdentityResolutionJobResponse -> String
$cshow :: GetIdentityResolutionJobResponse -> String
showsPrec :: Int -> GetIdentityResolutionJobResponse -> ShowS
$cshowsPrec :: Int -> GetIdentityResolutionJobResponse -> ShowS
Prelude.Show, forall x.
Rep GetIdentityResolutionJobResponse x
-> GetIdentityResolutionJobResponse
forall x.
GetIdentityResolutionJobResponse
-> Rep GetIdentityResolutionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIdentityResolutionJobResponse x
-> GetIdentityResolutionJobResponse
$cfrom :: forall x.
GetIdentityResolutionJobResponse
-> Rep GetIdentityResolutionJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIdentityResolutionJobResponse' 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:
--
-- 'autoMerging', 'getIdentityResolutionJobResponse_autoMerging' - Configuration settings for how to perform the auto-merging of profiles.
--
-- 'domainName', 'getIdentityResolutionJobResponse_domainName' - The unique name of the domain.
--
-- 'exportingLocation', 'getIdentityResolutionJobResponse_exportingLocation' - The S3 location where the Identity Resolution Job writes result files.
--
-- 'jobEndTime', 'getIdentityResolutionJobResponse_jobEndTime' - The timestamp of when the Identity Resolution Job was completed.
--
-- 'jobExpirationTime', 'getIdentityResolutionJobResponse_jobExpirationTime' - The timestamp of when the Identity Resolution Job will expire.
--
-- 'jobId', 'getIdentityResolutionJobResponse_jobId' - The unique identifier of the Identity Resolution Job.
--
-- 'jobStartTime', 'getIdentityResolutionJobResponse_jobStartTime' - The timestamp of when the Identity Resolution Job was started or will be
-- started.
--
-- 'jobStats', 'getIdentityResolutionJobResponse_jobStats' - Statistics about the Identity Resolution Job.
--
-- 'lastUpdatedAt', 'getIdentityResolutionJobResponse_lastUpdatedAt' - The timestamp of when the Identity Resolution Job was most recently
-- edited.
--
-- 'message', 'getIdentityResolutionJobResponse_message' - The error messages that are generated when the Identity Resolution Job
-- runs.
--
-- 'status', 'getIdentityResolutionJobResponse_status' - The status of the Identity Resolution Job.
--
-- -   @PENDING@: The Identity Resolution Job is scheduled but has not
--     started yet. If you turn off the Identity Resolution feature in your
--     domain, jobs in the @PENDING@ state are deleted.
--
-- -   @PREPROCESSING@: The Identity Resolution Job is loading your data.
--
-- -   @FIND_MATCHING@: The Identity Resolution Job is using the machine
--     learning model to identify profiles that belong to the same matching
--     group.
--
-- -   @MERGING@: The Identity Resolution Job is merging duplicate
--     profiles.
--
-- -   @COMPLETED@: The Identity Resolution Job completed successfully.
--
-- -   @PARTIAL_SUCCESS@: There\'s a system error and not all of the data
--     is merged. The Identity Resolution Job writes a message indicating
--     the source of the problem.
--
-- -   @FAILED@: The Identity Resolution Job did not merge any data. It
--     writes a message indicating the source of the problem.
--
-- 'httpStatus', 'getIdentityResolutionJobResponse_httpStatus' - The response's http status code.
newGetIdentityResolutionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetIdentityResolutionJobResponse
newGetIdentityResolutionJobResponse :: Int -> GetIdentityResolutionJobResponse
newGetIdentityResolutionJobResponse Int
pHttpStatus_ =
  GetIdentityResolutionJobResponse'
    { $sel:autoMerging:GetIdentityResolutionJobResponse' :: Maybe AutoMerging
autoMerging =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:GetIdentityResolutionJobResponse' :: Maybe Text
domainName = forall a. Maybe a
Prelude.Nothing,
      $sel:exportingLocation:GetIdentityResolutionJobResponse' :: Maybe ExportingLocation
exportingLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:jobEndTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExpirationTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobExpirationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetIdentityResolutionJobResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobStartTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:jobStats:GetIdentityResolutionJobResponse' :: Maybe JobStats
jobStats = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:GetIdentityResolutionJobResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:message:GetIdentityResolutionJobResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetIdentityResolutionJobResponse' :: Maybe IdentityResolutionJobStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetIdentityResolutionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Configuration settings for how to perform the auto-merging of profiles.
getIdentityResolutionJobResponse_autoMerging :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe AutoMerging)
getIdentityResolutionJobResponse_autoMerging :: Lens' GetIdentityResolutionJobResponse (Maybe AutoMerging)
getIdentityResolutionJobResponse_autoMerging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe AutoMerging
autoMerging :: Maybe AutoMerging
$sel:autoMerging:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe AutoMerging
autoMerging} -> Maybe AutoMerging
autoMerging) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe AutoMerging
a -> GetIdentityResolutionJobResponse
s {$sel:autoMerging:GetIdentityResolutionJobResponse' :: Maybe AutoMerging
autoMerging = Maybe AutoMerging
a} :: GetIdentityResolutionJobResponse)

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

-- | The S3 location where the Identity Resolution Job writes result files.
getIdentityResolutionJobResponse_exportingLocation :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe ExportingLocation)
getIdentityResolutionJobResponse_exportingLocation :: Lens' GetIdentityResolutionJobResponse (Maybe ExportingLocation)
getIdentityResolutionJobResponse_exportingLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe ExportingLocation
exportingLocation :: Maybe ExportingLocation
$sel:exportingLocation:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe ExportingLocation
exportingLocation} -> Maybe ExportingLocation
exportingLocation) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe ExportingLocation
a -> GetIdentityResolutionJobResponse
s {$sel:exportingLocation:GetIdentityResolutionJobResponse' :: Maybe ExportingLocation
exportingLocation = Maybe ExportingLocation
a} :: GetIdentityResolutionJobResponse)

-- | The timestamp of when the Identity Resolution Job was completed.
getIdentityResolutionJobResponse_jobEndTime :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.UTCTime)
getIdentityResolutionJobResponse_jobEndTime :: Lens' GetIdentityResolutionJobResponse (Maybe UTCTime)
getIdentityResolutionJobResponse_jobEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe POSIX
jobEndTime :: Maybe POSIX
$sel:jobEndTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
jobEndTime} -> Maybe POSIX
jobEndTime) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe POSIX
a -> GetIdentityResolutionJobResponse
s {$sel:jobEndTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobEndTime = Maybe POSIX
a} :: GetIdentityResolutionJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The timestamp of when the Identity Resolution Job will expire.
getIdentityResolutionJobResponse_jobExpirationTime :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.UTCTime)
getIdentityResolutionJobResponse_jobExpirationTime :: Lens' GetIdentityResolutionJobResponse (Maybe UTCTime)
getIdentityResolutionJobResponse_jobExpirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe POSIX
jobExpirationTime :: Maybe POSIX
$sel:jobExpirationTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
jobExpirationTime} -> Maybe POSIX
jobExpirationTime) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe POSIX
a -> GetIdentityResolutionJobResponse
s {$sel:jobExpirationTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobExpirationTime = Maybe POSIX
a} :: GetIdentityResolutionJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The unique identifier of the Identity Resolution Job.
getIdentityResolutionJobResponse_jobId :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.Text)
getIdentityResolutionJobResponse_jobId :: Lens' GetIdentityResolutionJobResponse (Maybe Text)
getIdentityResolutionJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe Text
a -> GetIdentityResolutionJobResponse
s {$sel:jobId:GetIdentityResolutionJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: GetIdentityResolutionJobResponse)

-- | The timestamp of when the Identity Resolution Job was started or will be
-- started.
getIdentityResolutionJobResponse_jobStartTime :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.UTCTime)
getIdentityResolutionJobResponse_jobStartTime :: Lens' GetIdentityResolutionJobResponse (Maybe UTCTime)
getIdentityResolutionJobResponse_jobStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe POSIX
jobStartTime :: Maybe POSIX
$sel:jobStartTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
jobStartTime} -> Maybe POSIX
jobStartTime) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe POSIX
a -> GetIdentityResolutionJobResponse
s {$sel:jobStartTime:GetIdentityResolutionJobResponse' :: Maybe POSIX
jobStartTime = Maybe POSIX
a} :: GetIdentityResolutionJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Statistics about the Identity Resolution Job.
getIdentityResolutionJobResponse_jobStats :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe JobStats)
getIdentityResolutionJobResponse_jobStats :: Lens' GetIdentityResolutionJobResponse (Maybe JobStats)
getIdentityResolutionJobResponse_jobStats = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe JobStats
jobStats :: Maybe JobStats
$sel:jobStats:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe JobStats
jobStats} -> Maybe JobStats
jobStats) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe JobStats
a -> GetIdentityResolutionJobResponse
s {$sel:jobStats:GetIdentityResolutionJobResponse' :: Maybe JobStats
jobStats = Maybe JobStats
a} :: GetIdentityResolutionJobResponse)

-- | The timestamp of when the Identity Resolution Job was most recently
-- edited.
getIdentityResolutionJobResponse_lastUpdatedAt :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.UTCTime)
getIdentityResolutionJobResponse_lastUpdatedAt :: Lens' GetIdentityResolutionJobResponse (Maybe UTCTime)
getIdentityResolutionJobResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe POSIX
a -> GetIdentityResolutionJobResponse
s {$sel:lastUpdatedAt:GetIdentityResolutionJobResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetIdentityResolutionJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The error messages that are generated when the Identity Resolution Job
-- runs.
getIdentityResolutionJobResponse_message :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe Prelude.Text)
getIdentityResolutionJobResponse_message :: Lens' GetIdentityResolutionJobResponse (Maybe Text)
getIdentityResolutionJobResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe Text
message :: Maybe Text
$sel:message:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe Text
a -> GetIdentityResolutionJobResponse
s {$sel:message:GetIdentityResolutionJobResponse' :: Maybe Text
message = Maybe Text
a} :: GetIdentityResolutionJobResponse)

-- | The status of the Identity Resolution Job.
--
-- -   @PENDING@: The Identity Resolution Job is scheduled but has not
--     started yet. If you turn off the Identity Resolution feature in your
--     domain, jobs in the @PENDING@ state are deleted.
--
-- -   @PREPROCESSING@: The Identity Resolution Job is loading your data.
--
-- -   @FIND_MATCHING@: The Identity Resolution Job is using the machine
--     learning model to identify profiles that belong to the same matching
--     group.
--
-- -   @MERGING@: The Identity Resolution Job is merging duplicate
--     profiles.
--
-- -   @COMPLETED@: The Identity Resolution Job completed successfully.
--
-- -   @PARTIAL_SUCCESS@: There\'s a system error and not all of the data
--     is merged. The Identity Resolution Job writes a message indicating
--     the source of the problem.
--
-- -   @FAILED@: The Identity Resolution Job did not merge any data. It
--     writes a message indicating the source of the problem.
getIdentityResolutionJobResponse_status :: Lens.Lens' GetIdentityResolutionJobResponse (Prelude.Maybe IdentityResolutionJobStatus)
getIdentityResolutionJobResponse_status :: Lens'
  GetIdentityResolutionJobResponse
  (Maybe IdentityResolutionJobStatus)
getIdentityResolutionJobResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdentityResolutionJobResponse' {Maybe IdentityResolutionJobStatus
status :: Maybe IdentityResolutionJobStatus
$sel:status:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse
-> Maybe IdentityResolutionJobStatus
status} -> Maybe IdentityResolutionJobStatus
status) (\s :: GetIdentityResolutionJobResponse
s@GetIdentityResolutionJobResponse' {} Maybe IdentityResolutionJobStatus
a -> GetIdentityResolutionJobResponse
s {$sel:status:GetIdentityResolutionJobResponse' :: Maybe IdentityResolutionJobStatus
status = Maybe IdentityResolutionJobStatus
a} :: GetIdentityResolutionJobResponse)

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

instance
  Prelude.NFData
    GetIdentityResolutionJobResponse
  where
  rnf :: GetIdentityResolutionJobResponse -> ()
rnf GetIdentityResolutionJobResponse' {Int
Maybe Text
Maybe POSIX
Maybe AutoMerging
Maybe IdentityResolutionJobStatus
Maybe JobStats
Maybe ExportingLocation
httpStatus :: Int
status :: Maybe IdentityResolutionJobStatus
message :: Maybe Text
lastUpdatedAt :: Maybe POSIX
jobStats :: Maybe JobStats
jobStartTime :: Maybe POSIX
jobId :: Maybe Text
jobExpirationTime :: Maybe POSIX
jobEndTime :: Maybe POSIX
exportingLocation :: Maybe ExportingLocation
domainName :: Maybe Text
autoMerging :: Maybe AutoMerging
$sel:httpStatus:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Int
$sel:status:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse
-> Maybe IdentityResolutionJobStatus
$sel:message:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe Text
$sel:lastUpdatedAt:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
$sel:jobStats:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe JobStats
$sel:jobStartTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
$sel:jobId:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe Text
$sel:jobExpirationTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
$sel:jobEndTime:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe POSIX
$sel:exportingLocation:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe ExportingLocation
$sel:domainName:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe Text
$sel:autoMerging:GetIdentityResolutionJobResponse' :: GetIdentityResolutionJobResponse -> Maybe AutoMerging
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoMerging
autoMerging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExportingLocation
exportingLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
jobEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
jobExpirationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
jobStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobStats
jobStats
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe IdentityResolutionJobStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus