{-# 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.GetProfileObjectTypeTemplate
-- 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 the template information for a specific object type.
--
-- A template is a predefined ProfileObjectType, such as
-- “Salesforce-Account” or “Salesforce-Contact.” When a user sends a
-- ProfileObject, using the PutProfileObject API, with an ObjectTypeName
-- that matches one of the TemplateIds, it uses the mappings from the
-- template.
module Amazonka.CustomerProfiles.GetProfileObjectTypeTemplate
  ( -- * Creating a Request
    GetProfileObjectTypeTemplate (..),
    newGetProfileObjectTypeTemplate,

    -- * Request Lenses
    getProfileObjectTypeTemplate_templateId,

    -- * Destructuring the Response
    GetProfileObjectTypeTemplateResponse (..),
    newGetProfileObjectTypeTemplateResponse,

    -- * Response Lenses
    getProfileObjectTypeTemplateResponse_allowProfileCreation,
    getProfileObjectTypeTemplateResponse_fields,
    getProfileObjectTypeTemplateResponse_keys,
    getProfileObjectTypeTemplateResponse_sourceLastUpdatedTimestampFormat,
    getProfileObjectTypeTemplateResponse_sourceName,
    getProfileObjectTypeTemplateResponse_sourceObject,
    getProfileObjectTypeTemplateResponse_templateId,
    getProfileObjectTypeTemplateResponse_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:/ 'newGetProfileObjectTypeTemplate' smart constructor.
data GetProfileObjectTypeTemplate = GetProfileObjectTypeTemplate'
  { -- | A unique identifier for the object template.
    GetProfileObjectTypeTemplate -> Text
templateId :: Prelude.Text
  }
  deriving (GetProfileObjectTypeTemplate
-> GetProfileObjectTypeTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProfileObjectTypeTemplate
-> GetProfileObjectTypeTemplate -> Bool
$c/= :: GetProfileObjectTypeTemplate
-> GetProfileObjectTypeTemplate -> Bool
== :: GetProfileObjectTypeTemplate
-> GetProfileObjectTypeTemplate -> Bool
$c== :: GetProfileObjectTypeTemplate
-> GetProfileObjectTypeTemplate -> Bool
Prelude.Eq, ReadPrec [GetProfileObjectTypeTemplate]
ReadPrec GetProfileObjectTypeTemplate
Int -> ReadS GetProfileObjectTypeTemplate
ReadS [GetProfileObjectTypeTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProfileObjectTypeTemplate]
$creadListPrec :: ReadPrec [GetProfileObjectTypeTemplate]
readPrec :: ReadPrec GetProfileObjectTypeTemplate
$creadPrec :: ReadPrec GetProfileObjectTypeTemplate
readList :: ReadS [GetProfileObjectTypeTemplate]
$creadList :: ReadS [GetProfileObjectTypeTemplate]
readsPrec :: Int -> ReadS GetProfileObjectTypeTemplate
$creadsPrec :: Int -> ReadS GetProfileObjectTypeTemplate
Prelude.Read, Int -> GetProfileObjectTypeTemplate -> ShowS
[GetProfileObjectTypeTemplate] -> ShowS
GetProfileObjectTypeTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProfileObjectTypeTemplate] -> ShowS
$cshowList :: [GetProfileObjectTypeTemplate] -> ShowS
show :: GetProfileObjectTypeTemplate -> String
$cshow :: GetProfileObjectTypeTemplate -> String
showsPrec :: Int -> GetProfileObjectTypeTemplate -> ShowS
$cshowsPrec :: Int -> GetProfileObjectTypeTemplate -> ShowS
Prelude.Show, forall x.
Rep GetProfileObjectTypeTemplate x -> GetProfileObjectTypeTemplate
forall x.
GetProfileObjectTypeTemplate -> Rep GetProfileObjectTypeTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProfileObjectTypeTemplate x -> GetProfileObjectTypeTemplate
$cfrom :: forall x.
GetProfileObjectTypeTemplate -> Rep GetProfileObjectTypeTemplate x
Prelude.Generic)

-- |
-- Create a value of 'GetProfileObjectTypeTemplate' 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:
--
-- 'templateId', 'getProfileObjectTypeTemplate_templateId' - A unique identifier for the object template.
newGetProfileObjectTypeTemplate ::
  -- | 'templateId'
  Prelude.Text ->
  GetProfileObjectTypeTemplate
newGetProfileObjectTypeTemplate :: Text -> GetProfileObjectTypeTemplate
newGetProfileObjectTypeTemplate Text
pTemplateId_ =
  GetProfileObjectTypeTemplate'
    { $sel:templateId:GetProfileObjectTypeTemplate' :: Text
templateId =
        Text
pTemplateId_
    }

-- | A unique identifier for the object template.
getProfileObjectTypeTemplate_templateId :: Lens.Lens' GetProfileObjectTypeTemplate Prelude.Text
getProfileObjectTypeTemplate_templateId :: Lens' GetProfileObjectTypeTemplate Text
getProfileObjectTypeTemplate_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplate' {Text
templateId :: Text
$sel:templateId:GetProfileObjectTypeTemplate' :: GetProfileObjectTypeTemplate -> Text
templateId} -> Text
templateId) (\s :: GetProfileObjectTypeTemplate
s@GetProfileObjectTypeTemplate' {} Text
a -> GetProfileObjectTypeTemplate
s {$sel:templateId:GetProfileObjectTypeTemplate' :: Text
templateId = Text
a} :: GetProfileObjectTypeTemplate)

instance Core.AWSRequest GetProfileObjectTypeTemplate where
  type
    AWSResponse GetProfileObjectTypeTemplate =
      GetProfileObjectTypeTemplateResponse
  request :: (Service -> Service)
-> GetProfileObjectTypeTemplate
-> Request GetProfileObjectTypeTemplate
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 GetProfileObjectTypeTemplate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetProfileObjectTypeTemplate)))
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 Bool
-> Maybe (HashMap Text ObjectTypeField)
-> Maybe (HashMap Text [ObjectTypeKey])
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetProfileObjectTypeTemplateResponse
GetProfileObjectTypeTemplateResponse'
            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
"AllowProfileCreation")
            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
"Fields" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Keys" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SourceLastUpdatedTimestampFormat")
            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
"SourceName")
            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
"SourceObject")
            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
"TemplateId")
            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
    GetProfileObjectTypeTemplate
  where
  hashWithSalt :: Int -> GetProfileObjectTypeTemplate -> Int
hashWithSalt Int
_salt GetProfileObjectTypeTemplate' {Text
templateId :: Text
$sel:templateId:GetProfileObjectTypeTemplate' :: GetProfileObjectTypeTemplate -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateId

instance Prelude.NFData GetProfileObjectTypeTemplate where
  rnf :: GetProfileObjectTypeTemplate -> ()
rnf GetProfileObjectTypeTemplate' {Text
templateId :: Text
$sel:templateId:GetProfileObjectTypeTemplate' :: GetProfileObjectTypeTemplate -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
templateId

instance Data.ToHeaders GetProfileObjectTypeTemplate where
  toHeaders :: GetProfileObjectTypeTemplate -> 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 GetProfileObjectTypeTemplate where
  toPath :: GetProfileObjectTypeTemplate -> ByteString
toPath GetProfileObjectTypeTemplate' {Text
templateId :: Text
$sel:templateId:GetProfileObjectTypeTemplate' :: GetProfileObjectTypeTemplate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/templates/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
templateId]

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

-- | /See:/ 'newGetProfileObjectTypeTemplateResponse' smart constructor.
data GetProfileObjectTypeTemplateResponse = GetProfileObjectTypeTemplateResponse'
  { -- | Indicates whether a profile should be created when data is received if
    -- one doesn’t exist for an object of this type. The default is @FALSE@. If
    -- the AllowProfileCreation flag is set to @FALSE@, then the service tries
    -- to fetch a standard profile and associate this object with the profile.
    -- If it is set to @TRUE@, and if no match is found, then the service
    -- creates a new standard profile.
    GetProfileObjectTypeTemplateResponse -> Maybe Bool
allowProfileCreation :: Prelude.Maybe Prelude.Bool,
    -- | A map of the name and ObjectType field.
    GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text ObjectTypeField)
fields :: Prelude.Maybe (Prelude.HashMap Prelude.Text ObjectTypeField),
    -- | A list of unique keys that can be used to map data to the profile.
    GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text [ObjectTypeKey])
keys :: Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]),
    -- | The format of your @sourceLastUpdatedTimestamp@ that was previously set
    -- up.
    GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceLastUpdatedTimestampFormat :: Prelude.Maybe Prelude.Text,
    -- | The name of the source of the object template.
    GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceName :: Prelude.Maybe Prelude.Text,
    -- | The source of the object template.
    GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceObject :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the object template.
    GetProfileObjectTypeTemplateResponse -> Maybe Text
templateId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetProfileObjectTypeTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetProfileObjectTypeTemplateResponse
-> GetProfileObjectTypeTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProfileObjectTypeTemplateResponse
-> GetProfileObjectTypeTemplateResponse -> Bool
$c/= :: GetProfileObjectTypeTemplateResponse
-> GetProfileObjectTypeTemplateResponse -> Bool
== :: GetProfileObjectTypeTemplateResponse
-> GetProfileObjectTypeTemplateResponse -> Bool
$c== :: GetProfileObjectTypeTemplateResponse
-> GetProfileObjectTypeTemplateResponse -> Bool
Prelude.Eq, ReadPrec [GetProfileObjectTypeTemplateResponse]
ReadPrec GetProfileObjectTypeTemplateResponse
Int -> ReadS GetProfileObjectTypeTemplateResponse
ReadS [GetProfileObjectTypeTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProfileObjectTypeTemplateResponse]
$creadListPrec :: ReadPrec [GetProfileObjectTypeTemplateResponse]
readPrec :: ReadPrec GetProfileObjectTypeTemplateResponse
$creadPrec :: ReadPrec GetProfileObjectTypeTemplateResponse
readList :: ReadS [GetProfileObjectTypeTemplateResponse]
$creadList :: ReadS [GetProfileObjectTypeTemplateResponse]
readsPrec :: Int -> ReadS GetProfileObjectTypeTemplateResponse
$creadsPrec :: Int -> ReadS GetProfileObjectTypeTemplateResponse
Prelude.Read, Int -> GetProfileObjectTypeTemplateResponse -> ShowS
[GetProfileObjectTypeTemplateResponse] -> ShowS
GetProfileObjectTypeTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProfileObjectTypeTemplateResponse] -> ShowS
$cshowList :: [GetProfileObjectTypeTemplateResponse] -> ShowS
show :: GetProfileObjectTypeTemplateResponse -> String
$cshow :: GetProfileObjectTypeTemplateResponse -> String
showsPrec :: Int -> GetProfileObjectTypeTemplateResponse -> ShowS
$cshowsPrec :: Int -> GetProfileObjectTypeTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep GetProfileObjectTypeTemplateResponse x
-> GetProfileObjectTypeTemplateResponse
forall x.
GetProfileObjectTypeTemplateResponse
-> Rep GetProfileObjectTypeTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProfileObjectTypeTemplateResponse x
-> GetProfileObjectTypeTemplateResponse
$cfrom :: forall x.
GetProfileObjectTypeTemplateResponse
-> Rep GetProfileObjectTypeTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetProfileObjectTypeTemplateResponse' 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:
--
-- 'allowProfileCreation', 'getProfileObjectTypeTemplateResponse_allowProfileCreation' - Indicates whether a profile should be created when data is received if
-- one doesn’t exist for an object of this type. The default is @FALSE@. If
-- the AllowProfileCreation flag is set to @FALSE@, then the service tries
-- to fetch a standard profile and associate this object with the profile.
-- If it is set to @TRUE@, and if no match is found, then the service
-- creates a new standard profile.
--
-- 'fields', 'getProfileObjectTypeTemplateResponse_fields' - A map of the name and ObjectType field.
--
-- 'keys', 'getProfileObjectTypeTemplateResponse_keys' - A list of unique keys that can be used to map data to the profile.
--
-- 'sourceLastUpdatedTimestampFormat', 'getProfileObjectTypeTemplateResponse_sourceLastUpdatedTimestampFormat' - The format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up.
--
-- 'sourceName', 'getProfileObjectTypeTemplateResponse_sourceName' - The name of the source of the object template.
--
-- 'sourceObject', 'getProfileObjectTypeTemplateResponse_sourceObject' - The source of the object template.
--
-- 'templateId', 'getProfileObjectTypeTemplateResponse_templateId' - A unique identifier for the object template.
--
-- 'httpStatus', 'getProfileObjectTypeTemplateResponse_httpStatus' - The response's http status code.
newGetProfileObjectTypeTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetProfileObjectTypeTemplateResponse
newGetProfileObjectTypeTemplateResponse :: Int -> GetProfileObjectTypeTemplateResponse
newGetProfileObjectTypeTemplateResponse Int
pHttpStatus_ =
  GetProfileObjectTypeTemplateResponse'
    { $sel:allowProfileCreation:GetProfileObjectTypeTemplateResponse' :: Maybe Bool
allowProfileCreation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fields:GetProfileObjectTypeTemplateResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = forall a. Maybe a
Prelude.Nothing,
      $sel:keys:GetProfileObjectTypeTemplateResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sourceName:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceName = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceObject:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceObject = forall a. Maybe a
Prelude.Nothing,
      $sel:templateId:GetProfileObjectTypeTemplateResponse' :: Maybe Text
templateId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetProfileObjectTypeTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether a profile should be created when data is received if
-- one doesn’t exist for an object of this type. The default is @FALSE@. If
-- the AllowProfileCreation flag is set to @FALSE@, then the service tries
-- to fetch a standard profile and associate this object with the profile.
-- If it is set to @TRUE@, and if no match is found, then the service
-- creates a new standard profile.
getProfileObjectTypeTemplateResponse_allowProfileCreation :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe Prelude.Bool)
getProfileObjectTypeTemplateResponse_allowProfileCreation :: Lens' GetProfileObjectTypeTemplateResponse (Maybe Bool)
getProfileObjectTypeTemplateResponse_allowProfileCreation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe Bool
allowProfileCreation :: Maybe Bool
$sel:allowProfileCreation:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Bool
allowProfileCreation} -> Maybe Bool
allowProfileCreation) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe Bool
a -> GetProfileObjectTypeTemplateResponse
s {$sel:allowProfileCreation:GetProfileObjectTypeTemplateResponse' :: Maybe Bool
allowProfileCreation = Maybe Bool
a} :: GetProfileObjectTypeTemplateResponse)

-- | A map of the name and ObjectType field.
getProfileObjectTypeTemplateResponse_fields :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text ObjectTypeField))
getProfileObjectTypeTemplateResponse_fields :: Lens'
  GetProfileObjectTypeTemplateResponse
  (Maybe (HashMap Text ObjectTypeField))
getProfileObjectTypeTemplateResponse_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe (HashMap Text ObjectTypeField)
fields :: Maybe (HashMap Text ObjectTypeField)
$sel:fields:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text ObjectTypeField)
fields} -> Maybe (HashMap Text ObjectTypeField)
fields) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe (HashMap Text ObjectTypeField)
a -> GetProfileObjectTypeTemplateResponse
s {$sel:fields:GetProfileObjectTypeTemplateResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = Maybe (HashMap Text ObjectTypeField)
a} :: GetProfileObjectTypeTemplateResponse) 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

-- | A list of unique keys that can be used to map data to the profile.
getProfileObjectTypeTemplateResponse_keys :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]))
getProfileObjectTypeTemplateResponse_keys :: Lens'
  GetProfileObjectTypeTemplateResponse
  (Maybe (HashMap Text [ObjectTypeKey]))
getProfileObjectTypeTemplateResponse_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe (HashMap Text [ObjectTypeKey])
keys :: Maybe (HashMap Text [ObjectTypeKey])
$sel:keys:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text [ObjectTypeKey])
keys} -> Maybe (HashMap Text [ObjectTypeKey])
keys) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe (HashMap Text [ObjectTypeKey])
a -> GetProfileObjectTypeTemplateResponse
s {$sel:keys:GetProfileObjectTypeTemplateResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = Maybe (HashMap Text [ObjectTypeKey])
a} :: GetProfileObjectTypeTemplateResponse) 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 format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up.
getProfileObjectTypeTemplateResponse_sourceLastUpdatedTimestampFormat :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeTemplateResponse_sourceLastUpdatedTimestampFormat :: Lens' GetProfileObjectTypeTemplateResponse (Maybe Text)
getProfileObjectTypeTemplateResponse_sourceLastUpdatedTimestampFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe Text
sourceLastUpdatedTimestampFormat :: Maybe Text
$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceLastUpdatedTimestampFormat} -> Maybe Text
sourceLastUpdatedTimestampFormat) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe Text
a -> GetProfileObjectTypeTemplateResponse
s {$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat = Maybe Text
a} :: GetProfileObjectTypeTemplateResponse)

-- | The name of the source of the object template.
getProfileObjectTypeTemplateResponse_sourceName :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeTemplateResponse_sourceName :: Lens' GetProfileObjectTypeTemplateResponse (Maybe Text)
getProfileObjectTypeTemplateResponse_sourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe Text
sourceName :: Maybe Text
$sel:sourceName:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceName} -> Maybe Text
sourceName) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe Text
a -> GetProfileObjectTypeTemplateResponse
s {$sel:sourceName:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceName = Maybe Text
a} :: GetProfileObjectTypeTemplateResponse)

-- | The source of the object template.
getProfileObjectTypeTemplateResponse_sourceObject :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeTemplateResponse_sourceObject :: Lens' GetProfileObjectTypeTemplateResponse (Maybe Text)
getProfileObjectTypeTemplateResponse_sourceObject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe Text
sourceObject :: Maybe Text
$sel:sourceObject:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
sourceObject} -> Maybe Text
sourceObject) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe Text
a -> GetProfileObjectTypeTemplateResponse
s {$sel:sourceObject:GetProfileObjectTypeTemplateResponse' :: Maybe Text
sourceObject = Maybe Text
a} :: GetProfileObjectTypeTemplateResponse)

-- | A unique identifier for the object template.
getProfileObjectTypeTemplateResponse_templateId :: Lens.Lens' GetProfileObjectTypeTemplateResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeTemplateResponse_templateId :: Lens' GetProfileObjectTypeTemplateResponse (Maybe Text)
getProfileObjectTypeTemplateResponse_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeTemplateResponse' {Maybe Text
templateId :: Maybe Text
$sel:templateId:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
templateId} -> Maybe Text
templateId) (\s :: GetProfileObjectTypeTemplateResponse
s@GetProfileObjectTypeTemplateResponse' {} Maybe Text
a -> GetProfileObjectTypeTemplateResponse
s {$sel:templateId:GetProfileObjectTypeTemplateResponse' :: Maybe Text
templateId = Maybe Text
a} :: GetProfileObjectTypeTemplateResponse)

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

instance
  Prelude.NFData
    GetProfileObjectTypeTemplateResponse
  where
  rnf :: GetProfileObjectTypeTemplateResponse -> ()
rnf GetProfileObjectTypeTemplateResponse' {Int
Maybe Bool
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text ObjectTypeField)
httpStatus :: Int
templateId :: Maybe Text
sourceObject :: Maybe Text
sourceName :: Maybe Text
sourceLastUpdatedTimestampFormat :: Maybe Text
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
allowProfileCreation :: Maybe Bool
$sel:httpStatus:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Int
$sel:templateId:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
$sel:sourceObject:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
$sel:sourceName:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Text
$sel:keys:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse
-> Maybe (HashMap Text ObjectTypeField)
$sel:allowProfileCreation:GetProfileObjectTypeTemplateResponse' :: GetProfileObjectTypeTemplateResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowProfileCreation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ObjectTypeField)
fields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [ObjectTypeKey])
keys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceLastUpdatedTimestampFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceObject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus