{-# 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.GetProfileObjectType
-- 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 object types for a specific domain.
module Amazonka.CustomerProfiles.GetProfileObjectType
  ( -- * Creating a Request
    GetProfileObjectType (..),
    newGetProfileObjectType,

    -- * Request Lenses
    getProfileObjectType_domainName,
    getProfileObjectType_objectTypeName,

    -- * Destructuring the Response
    GetProfileObjectTypeResponse (..),
    newGetProfileObjectTypeResponse,

    -- * Response Lenses
    getProfileObjectTypeResponse_allowProfileCreation,
    getProfileObjectTypeResponse_createdAt,
    getProfileObjectTypeResponse_encryptionKey,
    getProfileObjectTypeResponse_expirationDays,
    getProfileObjectTypeResponse_fields,
    getProfileObjectTypeResponse_keys,
    getProfileObjectTypeResponse_lastUpdatedAt,
    getProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat,
    getProfileObjectTypeResponse_tags,
    getProfileObjectTypeResponse_templateId,
    getProfileObjectTypeResponse_httpStatus,
    getProfileObjectTypeResponse_objectTypeName,
    getProfileObjectTypeResponse_description,
  )
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:/ 'newGetProfileObjectType' smart constructor.
data GetProfileObjectType = GetProfileObjectType'
  { -- | The unique name of the domain.
    GetProfileObjectType -> Text
domainName :: Prelude.Text,
    -- | The name of the profile object type.
    GetProfileObjectType -> Text
objectTypeName :: Prelude.Text
  }
  deriving (GetProfileObjectType -> GetProfileObjectType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProfileObjectType -> GetProfileObjectType -> Bool
$c/= :: GetProfileObjectType -> GetProfileObjectType -> Bool
== :: GetProfileObjectType -> GetProfileObjectType -> Bool
$c== :: GetProfileObjectType -> GetProfileObjectType -> Bool
Prelude.Eq, ReadPrec [GetProfileObjectType]
ReadPrec GetProfileObjectType
Int -> ReadS GetProfileObjectType
ReadS [GetProfileObjectType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProfileObjectType]
$creadListPrec :: ReadPrec [GetProfileObjectType]
readPrec :: ReadPrec GetProfileObjectType
$creadPrec :: ReadPrec GetProfileObjectType
readList :: ReadS [GetProfileObjectType]
$creadList :: ReadS [GetProfileObjectType]
readsPrec :: Int -> ReadS GetProfileObjectType
$creadsPrec :: Int -> ReadS GetProfileObjectType
Prelude.Read, Int -> GetProfileObjectType -> ShowS
[GetProfileObjectType] -> ShowS
GetProfileObjectType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProfileObjectType] -> ShowS
$cshowList :: [GetProfileObjectType] -> ShowS
show :: GetProfileObjectType -> String
$cshow :: GetProfileObjectType -> String
showsPrec :: Int -> GetProfileObjectType -> ShowS
$cshowsPrec :: Int -> GetProfileObjectType -> ShowS
Prelude.Show, forall x. Rep GetProfileObjectType x -> GetProfileObjectType
forall x. GetProfileObjectType -> Rep GetProfileObjectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetProfileObjectType x -> GetProfileObjectType
$cfrom :: forall x. GetProfileObjectType -> Rep GetProfileObjectType x
Prelude.Generic)

-- |
-- Create a value of 'GetProfileObjectType' 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', 'getProfileObjectType_domainName' - The unique name of the domain.
--
-- 'objectTypeName', 'getProfileObjectType_objectTypeName' - The name of the profile object type.
newGetProfileObjectType ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'objectTypeName'
  Prelude.Text ->
  GetProfileObjectType
newGetProfileObjectType :: Text -> Text -> GetProfileObjectType
newGetProfileObjectType Text
pDomainName_ Text
pObjectTypeName_ =
  GetProfileObjectType'
    { $sel:domainName:GetProfileObjectType' :: Text
domainName = Text
pDomainName_,
      $sel:objectTypeName:GetProfileObjectType' :: Text
objectTypeName = Text
pObjectTypeName_
    }

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

-- | The name of the profile object type.
getProfileObjectType_objectTypeName :: Lens.Lens' GetProfileObjectType Prelude.Text
getProfileObjectType_objectTypeName :: Lens' GetProfileObjectType Text
getProfileObjectType_objectTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectType' {Text
objectTypeName :: Text
$sel:objectTypeName:GetProfileObjectType' :: GetProfileObjectType -> Text
objectTypeName} -> Text
objectTypeName) (\s :: GetProfileObjectType
s@GetProfileObjectType' {} Text
a -> GetProfileObjectType
s {$sel:objectTypeName:GetProfileObjectType' :: Text
objectTypeName = Text
a} :: GetProfileObjectType)

instance Core.AWSRequest GetProfileObjectType where
  type
    AWSResponse GetProfileObjectType =
      GetProfileObjectTypeResponse
  request :: (Service -> Service)
-> GetProfileObjectType -> Request GetProfileObjectType
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 GetProfileObjectType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetProfileObjectType)))
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 POSIX
-> Maybe Text
-> Maybe Natural
-> Maybe (HashMap Text ObjectTypeField)
-> Maybe (HashMap Text [ObjectTypeKey])
-> Maybe POSIX
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Int
-> Text
-> Text
-> GetProfileObjectTypeResponse
GetProfileObjectTypeResponse'
            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
"CreatedAt")
            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
"EncryptionKey")
            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
"ExpirationDays")
            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
"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
"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
"Tags" 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
"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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ObjectTypeName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Description")
      )

instance Prelude.Hashable GetProfileObjectType where
  hashWithSalt :: Int -> GetProfileObjectType -> Int
hashWithSalt Int
_salt GetProfileObjectType' {Text
objectTypeName :: Text
domainName :: Text
$sel:objectTypeName:GetProfileObjectType' :: GetProfileObjectType -> Text
$sel:domainName:GetProfileObjectType' :: GetProfileObjectType -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectTypeName

instance Prelude.NFData GetProfileObjectType where
  rnf :: GetProfileObjectType -> ()
rnf GetProfileObjectType' {Text
objectTypeName :: Text
domainName :: Text
$sel:objectTypeName:GetProfileObjectType' :: GetProfileObjectType -> Text
$sel:domainName:GetProfileObjectType' :: GetProfileObjectType -> 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
objectTypeName

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

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

-- | /See:/ 'newGetProfileObjectTypeResponse' smart constructor.
data GetProfileObjectTypeResponse = GetProfileObjectTypeResponse'
  { -- | 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.
    GetProfileObjectTypeResponse -> Maybe Bool
allowProfileCreation :: Prelude.Maybe Prelude.Bool,
    -- | The timestamp of when the domain was created.
    GetProfileObjectTypeResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The customer-provided key to encrypt the profile object that will be
    -- created in this profile object type.
    GetProfileObjectTypeResponse -> Maybe Text
encryptionKey :: Prelude.Maybe Prelude.Text,
    -- | The number of days until the data in the object expires.
    GetProfileObjectTypeResponse -> Maybe Natural
expirationDays :: Prelude.Maybe Prelude.Natural,
    -- | A map of the name and ObjectType field.
    GetProfileObjectTypeResponse
-> 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.
    GetProfileObjectTypeResponse
-> Maybe (HashMap Text [ObjectTypeKey])
keys :: Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]),
    -- | The timestamp of when the domain was most recently edited.
    GetProfileObjectTypeResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | The format of your @sourceLastUpdatedTimestamp@ that was previously set
    -- up.
    GetProfileObjectTypeResponse -> Maybe Text
sourceLastUpdatedTimestampFormat :: Prelude.Maybe Prelude.Text,
    -- | The tags used to organize, track, or control access for this resource.
    GetProfileObjectTypeResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A unique identifier for the object template.
    GetProfileObjectTypeResponse -> Maybe Text
templateId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetProfileObjectTypeResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the profile object type.
    GetProfileObjectTypeResponse -> Text
objectTypeName :: Prelude.Text,
    -- | The description of the profile object type.
    GetProfileObjectTypeResponse -> Text
description :: Prelude.Text
  }
  deriving (GetProfileObjectTypeResponse
-> GetProfileObjectTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProfileObjectTypeResponse
-> GetProfileObjectTypeResponse -> Bool
$c/= :: GetProfileObjectTypeResponse
-> GetProfileObjectTypeResponse -> Bool
== :: GetProfileObjectTypeResponse
-> GetProfileObjectTypeResponse -> Bool
$c== :: GetProfileObjectTypeResponse
-> GetProfileObjectTypeResponse -> Bool
Prelude.Eq, ReadPrec [GetProfileObjectTypeResponse]
ReadPrec GetProfileObjectTypeResponse
Int -> ReadS GetProfileObjectTypeResponse
ReadS [GetProfileObjectTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProfileObjectTypeResponse]
$creadListPrec :: ReadPrec [GetProfileObjectTypeResponse]
readPrec :: ReadPrec GetProfileObjectTypeResponse
$creadPrec :: ReadPrec GetProfileObjectTypeResponse
readList :: ReadS [GetProfileObjectTypeResponse]
$creadList :: ReadS [GetProfileObjectTypeResponse]
readsPrec :: Int -> ReadS GetProfileObjectTypeResponse
$creadsPrec :: Int -> ReadS GetProfileObjectTypeResponse
Prelude.Read, Int -> GetProfileObjectTypeResponse -> ShowS
[GetProfileObjectTypeResponse] -> ShowS
GetProfileObjectTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProfileObjectTypeResponse] -> ShowS
$cshowList :: [GetProfileObjectTypeResponse] -> ShowS
show :: GetProfileObjectTypeResponse -> String
$cshow :: GetProfileObjectTypeResponse -> String
showsPrec :: Int -> GetProfileObjectTypeResponse -> ShowS
$cshowsPrec :: Int -> GetProfileObjectTypeResponse -> ShowS
Prelude.Show, forall x.
Rep GetProfileObjectTypeResponse x -> GetProfileObjectTypeResponse
forall x.
GetProfileObjectTypeResponse -> Rep GetProfileObjectTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProfileObjectTypeResponse x -> GetProfileObjectTypeResponse
$cfrom :: forall x.
GetProfileObjectTypeResponse -> Rep GetProfileObjectTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetProfileObjectTypeResponse' 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', 'getProfileObjectTypeResponse_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.
--
-- 'createdAt', 'getProfileObjectTypeResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'encryptionKey', 'getProfileObjectTypeResponse_encryptionKey' - The customer-provided key to encrypt the profile object that will be
-- created in this profile object type.
--
-- 'expirationDays', 'getProfileObjectTypeResponse_expirationDays' - The number of days until the data in the object expires.
--
-- 'fields', 'getProfileObjectTypeResponse_fields' - A map of the name and ObjectType field.
--
-- 'keys', 'getProfileObjectTypeResponse_keys' - A list of unique keys that can be used to map data to the profile.
--
-- 'lastUpdatedAt', 'getProfileObjectTypeResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
--
-- 'sourceLastUpdatedTimestampFormat', 'getProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat' - The format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up.
--
-- 'tags', 'getProfileObjectTypeResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'templateId', 'getProfileObjectTypeResponse_templateId' - A unique identifier for the object template.
--
-- 'httpStatus', 'getProfileObjectTypeResponse_httpStatus' - The response's http status code.
--
-- 'objectTypeName', 'getProfileObjectTypeResponse_objectTypeName' - The name of the profile object type.
--
-- 'description', 'getProfileObjectTypeResponse_description' - The description of the profile object type.
newGetProfileObjectTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'objectTypeName'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  GetProfileObjectTypeResponse
newGetProfileObjectTypeResponse :: Int -> Text -> Text -> GetProfileObjectTypeResponse
newGetProfileObjectTypeResponse
  Int
pHttpStatus_
  Text
pObjectTypeName_
  Text
pDescription_ =
    GetProfileObjectTypeResponse'
      { $sel:allowProfileCreation:GetProfileObjectTypeResponse' :: Maybe Bool
allowProfileCreation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:createdAt:GetProfileObjectTypeResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionKey:GetProfileObjectTypeResponse' :: Maybe Text
encryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:expirationDays:GetProfileObjectTypeResponse' :: Maybe Natural
expirationDays = forall a. Maybe a
Prelude.Nothing,
        $sel:fields:GetProfileObjectTypeResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = forall a. Maybe a
Prelude.Nothing,
        $sel:keys:GetProfileObjectTypeResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = forall a. Maybe a
Prelude.Nothing,
        $sel:lastUpdatedAt:GetProfileObjectTypeResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetProfileObjectTypeResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:templateId:GetProfileObjectTypeResponse' :: Maybe Text
templateId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetProfileObjectTypeResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:objectTypeName:GetProfileObjectTypeResponse' :: Text
objectTypeName = Text
pObjectTypeName_,
        $sel:description:GetProfileObjectTypeResponse' :: Text
description = Text
pDescription_
      }

-- | 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.
getProfileObjectTypeResponse_allowProfileCreation :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.Bool)
getProfileObjectTypeResponse_allowProfileCreation :: Lens' GetProfileObjectTypeResponse (Maybe Bool)
getProfileObjectTypeResponse_allowProfileCreation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe Bool
allowProfileCreation :: Maybe Bool
$sel:allowProfileCreation:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Bool
allowProfileCreation} -> Maybe Bool
allowProfileCreation) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe Bool
a -> GetProfileObjectTypeResponse
s {$sel:allowProfileCreation:GetProfileObjectTypeResponse' :: Maybe Bool
allowProfileCreation = Maybe Bool
a} :: GetProfileObjectTypeResponse)

-- | The timestamp of when the domain was created.
getProfileObjectTypeResponse_createdAt :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.UTCTime)
getProfileObjectTypeResponse_createdAt :: Lens' GetProfileObjectTypeResponse (Maybe UTCTime)
getProfileObjectTypeResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe POSIX
a -> GetProfileObjectTypeResponse
s {$sel:createdAt:GetProfileObjectTypeResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: GetProfileObjectTypeResponse) 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 customer-provided key to encrypt the profile object that will be
-- created in this profile object type.
getProfileObjectTypeResponse_encryptionKey :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeResponse_encryptionKey :: Lens' GetProfileObjectTypeResponse (Maybe Text)
getProfileObjectTypeResponse_encryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe Text
encryptionKey :: Maybe Text
$sel:encryptionKey:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
encryptionKey} -> Maybe Text
encryptionKey) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe Text
a -> GetProfileObjectTypeResponse
s {$sel:encryptionKey:GetProfileObjectTypeResponse' :: Maybe Text
encryptionKey = Maybe Text
a} :: GetProfileObjectTypeResponse)

-- | The number of days until the data in the object expires.
getProfileObjectTypeResponse_expirationDays :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.Natural)
getProfileObjectTypeResponse_expirationDays :: Lens' GetProfileObjectTypeResponse (Maybe Natural)
getProfileObjectTypeResponse_expirationDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe Natural
expirationDays :: Maybe Natural
$sel:expirationDays:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Natural
expirationDays} -> Maybe Natural
expirationDays) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe Natural
a -> GetProfileObjectTypeResponse
s {$sel:expirationDays:GetProfileObjectTypeResponse' :: Maybe Natural
expirationDays = Maybe Natural
a} :: GetProfileObjectTypeResponse)

-- | A map of the name and ObjectType field.
getProfileObjectTypeResponse_fields :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text ObjectTypeField))
getProfileObjectTypeResponse_fields :: Lens'
  GetProfileObjectTypeResponse (Maybe (HashMap Text ObjectTypeField))
getProfileObjectTypeResponse_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe (HashMap Text ObjectTypeField)
fields :: Maybe (HashMap Text ObjectTypeField)
$sel:fields:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse
-> Maybe (HashMap Text ObjectTypeField)
fields} -> Maybe (HashMap Text ObjectTypeField)
fields) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe (HashMap Text ObjectTypeField)
a -> GetProfileObjectTypeResponse
s {$sel:fields:GetProfileObjectTypeResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = Maybe (HashMap Text ObjectTypeField)
a} :: GetProfileObjectTypeResponse) 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.
getProfileObjectTypeResponse_keys :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]))
getProfileObjectTypeResponse_keys :: Lens'
  GetProfileObjectTypeResponse (Maybe (HashMap Text [ObjectTypeKey]))
getProfileObjectTypeResponse_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe (HashMap Text [ObjectTypeKey])
keys :: Maybe (HashMap Text [ObjectTypeKey])
$sel:keys:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse
-> Maybe (HashMap Text [ObjectTypeKey])
keys} -> Maybe (HashMap Text [ObjectTypeKey])
keys) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe (HashMap Text [ObjectTypeKey])
a -> GetProfileObjectTypeResponse
s {$sel:keys:GetProfileObjectTypeResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = Maybe (HashMap Text [ObjectTypeKey])
a} :: GetProfileObjectTypeResponse) 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 timestamp of when the domain was most recently edited.
getProfileObjectTypeResponse_lastUpdatedAt :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.UTCTime)
getProfileObjectTypeResponse_lastUpdatedAt :: Lens' GetProfileObjectTypeResponse (Maybe UTCTime)
getProfileObjectTypeResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe POSIX
a -> GetProfileObjectTypeResponse
s {$sel:lastUpdatedAt:GetProfileObjectTypeResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetProfileObjectTypeResponse) 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 format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up.
getProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat :: Lens' GetProfileObjectTypeResponse (Maybe Text)
getProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe Text
sourceLastUpdatedTimestampFormat :: Maybe Text
$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
sourceLastUpdatedTimestampFormat} -> Maybe Text
sourceLastUpdatedTimestampFormat) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe Text
a -> GetProfileObjectTypeResponse
s {$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat = Maybe Text
a} :: GetProfileObjectTypeResponse)

-- | The tags used to organize, track, or control access for this resource.
getProfileObjectTypeResponse_tags :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getProfileObjectTypeResponse_tags :: Lens' GetProfileObjectTypeResponse (Maybe (HashMap Text Text))
getProfileObjectTypeResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe (HashMap Text Text)
a -> GetProfileObjectTypeResponse
s {$sel:tags:GetProfileObjectTypeResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetProfileObjectTypeResponse) 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 unique identifier for the object template.
getProfileObjectTypeResponse_templateId :: Lens.Lens' GetProfileObjectTypeResponse (Prelude.Maybe Prelude.Text)
getProfileObjectTypeResponse_templateId :: Lens' GetProfileObjectTypeResponse (Maybe Text)
getProfileObjectTypeResponse_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Maybe Text
templateId :: Maybe Text
$sel:templateId:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
templateId} -> Maybe Text
templateId) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Maybe Text
a -> GetProfileObjectTypeResponse
s {$sel:templateId:GetProfileObjectTypeResponse' :: Maybe Text
templateId = Maybe Text
a} :: GetProfileObjectTypeResponse)

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

-- | The name of the profile object type.
getProfileObjectTypeResponse_objectTypeName :: Lens.Lens' GetProfileObjectTypeResponse Prelude.Text
getProfileObjectTypeResponse_objectTypeName :: Lens' GetProfileObjectTypeResponse Text
getProfileObjectTypeResponse_objectTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Text
objectTypeName :: Text
$sel:objectTypeName:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Text
objectTypeName} -> Text
objectTypeName) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Text
a -> GetProfileObjectTypeResponse
s {$sel:objectTypeName:GetProfileObjectTypeResponse' :: Text
objectTypeName = Text
a} :: GetProfileObjectTypeResponse)

-- | The description of the profile object type.
getProfileObjectTypeResponse_description :: Lens.Lens' GetProfileObjectTypeResponse Prelude.Text
getProfileObjectTypeResponse_description :: Lens' GetProfileObjectTypeResponse Text
getProfileObjectTypeResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProfileObjectTypeResponse' {Text
description :: Text
$sel:description:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Text
description} -> Text
description) (\s :: GetProfileObjectTypeResponse
s@GetProfileObjectTypeResponse' {} Text
a -> GetProfileObjectTypeResponse
s {$sel:description:GetProfileObjectTypeResponse' :: Text
description = Text
a} :: GetProfileObjectTypeResponse)

instance Prelude.NFData GetProfileObjectTypeResponse where
  rnf :: GetProfileObjectTypeResponse -> ()
rnf GetProfileObjectTypeResponse' {Int
Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text Text)
Maybe (HashMap Text ObjectTypeField)
Maybe POSIX
Text
description :: Text
objectTypeName :: Text
httpStatus :: Int
templateId :: Maybe Text
tags :: Maybe (HashMap Text Text)
sourceLastUpdatedTimestampFormat :: Maybe Text
lastUpdatedAt :: Maybe POSIX
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
expirationDays :: Maybe Natural
encryptionKey :: Maybe Text
createdAt :: Maybe POSIX
allowProfileCreation :: Maybe Bool
$sel:description:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Text
$sel:objectTypeName:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Text
$sel:httpStatus:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Int
$sel:templateId:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
$sel:tags:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe (HashMap Text Text)
$sel:sourceLastUpdatedTimestampFormat:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
$sel:lastUpdatedAt:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe POSIX
$sel:keys:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse
-> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse
-> Maybe (HashMap Text ObjectTypeField)
$sel:expirationDays:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Natural
$sel:encryptionKey:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe Text
$sel:createdAt:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> Maybe POSIX
$sel:allowProfileCreation:GetProfileObjectTypeResponse' :: GetProfileObjectTypeResponse -> 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 POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
encryptionKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
expirationDays
      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 POSIX
lastUpdatedAt
      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 (HashMap Text Text)
tags
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
objectTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description