{-# 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.PutProfileObjectType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Defines a ProfileObjectType.
--
-- To add or remove tags on an existing ObjectType, see
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_TagResource.html TagResource>\/<https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_UntagResource.html UntagResource>.
module Amazonka.CustomerProfiles.PutProfileObjectType
  ( -- * Creating a Request
    PutProfileObjectType (..),
    newPutProfileObjectType,

    -- * Request Lenses
    putProfileObjectType_allowProfileCreation,
    putProfileObjectType_encryptionKey,
    putProfileObjectType_expirationDays,
    putProfileObjectType_fields,
    putProfileObjectType_keys,
    putProfileObjectType_sourceLastUpdatedTimestampFormat,
    putProfileObjectType_tags,
    putProfileObjectType_templateId,
    putProfileObjectType_domainName,
    putProfileObjectType_objectTypeName,
    putProfileObjectType_description,

    -- * Destructuring the Response
    PutProfileObjectTypeResponse (..),
    newPutProfileObjectTypeResponse,

    -- * Response Lenses
    putProfileObjectTypeResponse_allowProfileCreation,
    putProfileObjectTypeResponse_createdAt,
    putProfileObjectTypeResponse_encryptionKey,
    putProfileObjectTypeResponse_expirationDays,
    putProfileObjectTypeResponse_fields,
    putProfileObjectTypeResponse_keys,
    putProfileObjectTypeResponse_lastUpdatedAt,
    putProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat,
    putProfileObjectTypeResponse_tags,
    putProfileObjectTypeResponse_templateId,
    putProfileObjectTypeResponse_httpStatus,
    putProfileObjectTypeResponse_objectTypeName,
    putProfileObjectTypeResponse_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:/ 'newPutProfileObjectType' smart constructor.
data PutProfileObjectType = PutProfileObjectType'
  { -- | 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.
    PutProfileObjectType -> Maybe Bool
allowProfileCreation :: Prelude.Maybe Prelude.Bool,
    -- | The customer-provided key to encrypt the profile object that will be
    -- created in this profile object type.
    PutProfileObjectType -> Maybe Text
encryptionKey :: Prelude.Maybe Prelude.Text,
    -- | The number of days until the data in the object expires.
    PutProfileObjectType -> Maybe Natural
expirationDays :: Prelude.Maybe Prelude.Natural,
    -- | A map of the name and ObjectType field.
    PutProfileObjectType -> 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.
    PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
keys :: Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]),
    -- | The format of your @sourceLastUpdatedTimestamp@ that was previously set
    -- up.
    PutProfileObjectType -> Maybe Text
sourceLastUpdatedTimestampFormat :: Prelude.Maybe Prelude.Text,
    -- | The tags used to organize, track, or control access for this resource.
    PutProfileObjectType -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A unique identifier for the object template. For some attributes in the
    -- request, the service will use the default value from the object template
    -- when TemplateId is present. If these attributes are present in the
    -- request, the service may return a @BadRequestException@. These
    -- attributes include: AllowProfileCreation,
    -- SourceLastUpdatedTimestampFormat, Fields, and Keys. For example, if
    -- AllowProfileCreation is set to true when TemplateId is set, the service
    -- may return a @BadRequestException@.
    PutProfileObjectType -> Maybe Text
templateId :: Prelude.Maybe Prelude.Text,
    -- | The unique name of the domain.
    PutProfileObjectType -> Text
domainName :: Prelude.Text,
    -- | The name of the profile object type.
    PutProfileObjectType -> Text
objectTypeName :: Prelude.Text,
    -- | Description of the profile object type.
    PutProfileObjectType -> Text
description :: Prelude.Text
  }
  deriving (PutProfileObjectType -> PutProfileObjectType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutProfileObjectType -> PutProfileObjectType -> Bool
$c/= :: PutProfileObjectType -> PutProfileObjectType -> Bool
== :: PutProfileObjectType -> PutProfileObjectType -> Bool
$c== :: PutProfileObjectType -> PutProfileObjectType -> Bool
Prelude.Eq, ReadPrec [PutProfileObjectType]
ReadPrec PutProfileObjectType
Int -> ReadS PutProfileObjectType
ReadS [PutProfileObjectType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutProfileObjectType]
$creadListPrec :: ReadPrec [PutProfileObjectType]
readPrec :: ReadPrec PutProfileObjectType
$creadPrec :: ReadPrec PutProfileObjectType
readList :: ReadS [PutProfileObjectType]
$creadList :: ReadS [PutProfileObjectType]
readsPrec :: Int -> ReadS PutProfileObjectType
$creadsPrec :: Int -> ReadS PutProfileObjectType
Prelude.Read, Int -> PutProfileObjectType -> ShowS
[PutProfileObjectType] -> ShowS
PutProfileObjectType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutProfileObjectType] -> ShowS
$cshowList :: [PutProfileObjectType] -> ShowS
show :: PutProfileObjectType -> String
$cshow :: PutProfileObjectType -> String
showsPrec :: Int -> PutProfileObjectType -> ShowS
$cshowsPrec :: Int -> PutProfileObjectType -> ShowS
Prelude.Show, forall x. Rep PutProfileObjectType x -> PutProfileObjectType
forall x. PutProfileObjectType -> Rep PutProfileObjectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutProfileObjectType x -> PutProfileObjectType
$cfrom :: forall x. PutProfileObjectType -> Rep PutProfileObjectType x
Prelude.Generic)

-- |
-- Create a value of 'PutProfileObjectType' 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', 'putProfileObjectType_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.
--
-- 'encryptionKey', 'putProfileObjectType_encryptionKey' - The customer-provided key to encrypt the profile object that will be
-- created in this profile object type.
--
-- 'expirationDays', 'putProfileObjectType_expirationDays' - The number of days until the data in the object expires.
--
-- 'fields', 'putProfileObjectType_fields' - A map of the name and ObjectType field.
--
-- 'keys', 'putProfileObjectType_keys' - A list of unique keys that can be used to map data to the profile.
--
-- 'sourceLastUpdatedTimestampFormat', 'putProfileObjectType_sourceLastUpdatedTimestampFormat' - The format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up.
--
-- 'tags', 'putProfileObjectType_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'templateId', 'putProfileObjectType_templateId' - A unique identifier for the object template. For some attributes in the
-- request, the service will use the default value from the object template
-- when TemplateId is present. If these attributes are present in the
-- request, the service may return a @BadRequestException@. These
-- attributes include: AllowProfileCreation,
-- SourceLastUpdatedTimestampFormat, Fields, and Keys. For example, if
-- AllowProfileCreation is set to true when TemplateId is set, the service
-- may return a @BadRequestException@.
--
-- 'domainName', 'putProfileObjectType_domainName' - The unique name of the domain.
--
-- 'objectTypeName', 'putProfileObjectType_objectTypeName' - The name of the profile object type.
--
-- 'description', 'putProfileObjectType_description' - Description of the profile object type.
newPutProfileObjectType ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'objectTypeName'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  PutProfileObjectType
newPutProfileObjectType :: Text -> Text -> Text -> PutProfileObjectType
newPutProfileObjectType
  Text
pDomainName_
  Text
pObjectTypeName_
  Text
pDescription_ =
    PutProfileObjectType'
      { $sel:allowProfileCreation:PutProfileObjectType' :: Maybe Bool
allowProfileCreation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionKey:PutProfileObjectType' :: Maybe Text
encryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:expirationDays:PutProfileObjectType' :: Maybe Natural
expirationDays = forall a. Maybe a
Prelude.Nothing,
        $sel:fields:PutProfileObjectType' :: Maybe (HashMap Text ObjectTypeField)
fields = forall a. Maybe a
Prelude.Nothing,
        $sel:keys:PutProfileObjectType' :: Maybe (HashMap Text [ObjectTypeKey])
keys = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: Maybe Text
sourceLastUpdatedTimestampFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutProfileObjectType' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:templateId:PutProfileObjectType' :: Maybe Text
templateId = forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:PutProfileObjectType' :: Text
domainName = Text
pDomainName_,
        $sel:objectTypeName:PutProfileObjectType' :: Text
objectTypeName = Text
pObjectTypeName_,
        $sel:description:PutProfileObjectType' :: 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.
putProfileObjectType_allowProfileCreation :: Lens.Lens' PutProfileObjectType (Prelude.Maybe Prelude.Bool)
putProfileObjectType_allowProfileCreation :: Lens' PutProfileObjectType (Maybe Bool)
putProfileObjectType_allowProfileCreation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe Bool
allowProfileCreation :: Maybe Bool
$sel:allowProfileCreation:PutProfileObjectType' :: PutProfileObjectType -> Maybe Bool
allowProfileCreation} -> Maybe Bool
allowProfileCreation) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe Bool
a -> PutProfileObjectType
s {$sel:allowProfileCreation:PutProfileObjectType' :: Maybe Bool
allowProfileCreation = Maybe Bool
a} :: PutProfileObjectType)

-- | The customer-provided key to encrypt the profile object that will be
-- created in this profile object type.
putProfileObjectType_encryptionKey :: Lens.Lens' PutProfileObjectType (Prelude.Maybe Prelude.Text)
putProfileObjectType_encryptionKey :: Lens' PutProfileObjectType (Maybe Text)
putProfileObjectType_encryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe Text
encryptionKey :: Maybe Text
$sel:encryptionKey:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
encryptionKey} -> Maybe Text
encryptionKey) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe Text
a -> PutProfileObjectType
s {$sel:encryptionKey:PutProfileObjectType' :: Maybe Text
encryptionKey = Maybe Text
a} :: PutProfileObjectType)

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

-- | A map of the name and ObjectType field.
putProfileObjectType_fields :: Lens.Lens' PutProfileObjectType (Prelude.Maybe (Prelude.HashMap Prelude.Text ObjectTypeField))
putProfileObjectType_fields :: Lens' PutProfileObjectType (Maybe (HashMap Text ObjectTypeField))
putProfileObjectType_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe (HashMap Text ObjectTypeField)
fields :: Maybe (HashMap Text ObjectTypeField)
$sel:fields:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text ObjectTypeField)
fields} -> Maybe (HashMap Text ObjectTypeField)
fields) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe (HashMap Text ObjectTypeField)
a -> PutProfileObjectType
s {$sel:fields:PutProfileObjectType' :: Maybe (HashMap Text ObjectTypeField)
fields = Maybe (HashMap Text ObjectTypeField)
a} :: PutProfileObjectType) 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.
putProfileObjectType_keys :: Lens.Lens' PutProfileObjectType (Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]))
putProfileObjectType_keys :: Lens' PutProfileObjectType (Maybe (HashMap Text [ObjectTypeKey]))
putProfileObjectType_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe (HashMap Text [ObjectTypeKey])
keys :: Maybe (HashMap Text [ObjectTypeKey])
$sel:keys:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
keys} -> Maybe (HashMap Text [ObjectTypeKey])
keys) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe (HashMap Text [ObjectTypeKey])
a -> PutProfileObjectType
s {$sel:keys:PutProfileObjectType' :: Maybe (HashMap Text [ObjectTypeKey])
keys = Maybe (HashMap Text [ObjectTypeKey])
a} :: PutProfileObjectType) 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.
putProfileObjectType_sourceLastUpdatedTimestampFormat :: Lens.Lens' PutProfileObjectType (Prelude.Maybe Prelude.Text)
putProfileObjectType_sourceLastUpdatedTimestampFormat :: Lens' PutProfileObjectType (Maybe Text)
putProfileObjectType_sourceLastUpdatedTimestampFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe Text
sourceLastUpdatedTimestampFormat :: Maybe Text
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
sourceLastUpdatedTimestampFormat} -> Maybe Text
sourceLastUpdatedTimestampFormat) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe Text
a -> PutProfileObjectType
s {$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: Maybe Text
sourceLastUpdatedTimestampFormat = Maybe Text
a} :: PutProfileObjectType)

-- | The tags used to organize, track, or control access for this resource.
putProfileObjectType_tags :: Lens.Lens' PutProfileObjectType (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putProfileObjectType_tags :: Lens' PutProfileObjectType (Maybe (HashMap Text Text))
putProfileObjectType_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe (HashMap Text Text)
a -> PutProfileObjectType
s {$sel:tags:PutProfileObjectType' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutProfileObjectType) 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. For some attributes in the
-- request, the service will use the default value from the object template
-- when TemplateId is present. If these attributes are present in the
-- request, the service may return a @BadRequestException@. These
-- attributes include: AllowProfileCreation,
-- SourceLastUpdatedTimestampFormat, Fields, and Keys. For example, if
-- AllowProfileCreation is set to true when TemplateId is set, the service
-- may return a @BadRequestException@.
putProfileObjectType_templateId :: Lens.Lens' PutProfileObjectType (Prelude.Maybe Prelude.Text)
putProfileObjectType_templateId :: Lens' PutProfileObjectType (Maybe Text)
putProfileObjectType_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectType' {Maybe Text
templateId :: Maybe Text
$sel:templateId:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
templateId} -> Maybe Text
templateId) (\s :: PutProfileObjectType
s@PutProfileObjectType' {} Maybe Text
a -> PutProfileObjectType
s {$sel:templateId:PutProfileObjectType' :: Maybe Text
templateId = Maybe Text
a} :: PutProfileObjectType)

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

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

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

instance Core.AWSRequest PutProfileObjectType where
  type
    AWSResponse PutProfileObjectType =
      PutProfileObjectTypeResponse
  request :: (Service -> Service)
-> PutProfileObjectType -> Request PutProfileObjectType
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutProfileObjectType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutProfileObjectType)))
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
-> PutProfileObjectTypeResponse
PutProfileObjectTypeResponse'
            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 PutProfileObjectType where
  hashWithSalt :: Int -> PutProfileObjectType -> Int
hashWithSalt Int
_salt PutProfileObjectType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text Text)
Maybe (HashMap Text ObjectTypeField)
Text
description :: Text
objectTypeName :: Text
domainName :: Text
templateId :: Maybe Text
tags :: Maybe (HashMap Text Text)
sourceLastUpdatedTimestampFormat :: Maybe Text
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
expirationDays :: Maybe Natural
encryptionKey :: Maybe Text
allowProfileCreation :: Maybe Bool
$sel:description:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:objectTypeName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:domainName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:templateId:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:tags:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text Text)
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:keys:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text ObjectTypeField)
$sel:expirationDays:PutProfileObjectType' :: PutProfileObjectType -> Maybe Natural
$sel:encryptionKey:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:allowProfileCreation:PutProfileObjectType' :: PutProfileObjectType -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowProfileCreation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
encryptionKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
expirationDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text ObjectTypeField)
fields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [ObjectTypeKey])
keys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceLastUpdatedTimestampFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData PutProfileObjectType where
  rnf :: PutProfileObjectType -> ()
rnf PutProfileObjectType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text Text)
Maybe (HashMap Text ObjectTypeField)
Text
description :: Text
objectTypeName :: Text
domainName :: Text
templateId :: Maybe Text
tags :: Maybe (HashMap Text Text)
sourceLastUpdatedTimestampFormat :: Maybe Text
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
expirationDays :: Maybe Natural
encryptionKey :: Maybe Text
allowProfileCreation :: Maybe Bool
$sel:description:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:objectTypeName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:domainName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:templateId:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:tags:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text Text)
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:keys:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text ObjectTypeField)
$sel:expirationDays:PutProfileObjectType' :: PutProfileObjectType -> Maybe Natural
$sel:encryptionKey:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:allowProfileCreation:PutProfileObjectType' :: PutProfileObjectType -> 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 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 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 Text
domainName
      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

instance Data.ToHeaders PutProfileObjectType where
  toHeaders :: PutProfileObjectType -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutProfileObjectType where
  toJSON :: PutProfileObjectType -> Value
toJSON PutProfileObjectType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text Text)
Maybe (HashMap Text ObjectTypeField)
Text
description :: Text
objectTypeName :: Text
domainName :: Text
templateId :: Maybe Text
tags :: Maybe (HashMap Text Text)
sourceLastUpdatedTimestampFormat :: Maybe Text
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
expirationDays :: Maybe Natural
encryptionKey :: Maybe Text
allowProfileCreation :: Maybe Bool
$sel:description:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:objectTypeName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:domainName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:templateId:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:tags:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text Text)
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:keys:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text ObjectTypeField)
$sel:expirationDays:PutProfileObjectType' :: PutProfileObjectType -> Maybe Natural
$sel:encryptionKey:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:allowProfileCreation:PutProfileObjectType' :: PutProfileObjectType -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowProfileCreation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
allowProfileCreation,
            (Key
"EncryptionKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
encryptionKey,
            (Key
"ExpirationDays" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
expirationDays,
            (Key
"Fields" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text ObjectTypeField)
fields,
            (Key
"Keys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text [ObjectTypeKey])
keys,
            (Key
"SourceLastUpdatedTimestampFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sourceLastUpdatedTimestampFormat,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            (Key
"TemplateId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
templateId,
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description)
          ]
      )

instance Data.ToPath PutProfileObjectType where
  toPath :: PutProfileObjectType -> ByteString
toPath PutProfileObjectType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [ObjectTypeKey])
Maybe (HashMap Text Text)
Maybe (HashMap Text ObjectTypeField)
Text
description :: Text
objectTypeName :: Text
domainName :: Text
templateId :: Maybe Text
tags :: Maybe (HashMap Text Text)
sourceLastUpdatedTimestampFormat :: Maybe Text
keys :: Maybe (HashMap Text [ObjectTypeKey])
fields :: Maybe (HashMap Text ObjectTypeField)
expirationDays :: Maybe Natural
encryptionKey :: Maybe Text
allowProfileCreation :: Maybe Bool
$sel:description:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:objectTypeName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:domainName:PutProfileObjectType' :: PutProfileObjectType -> Text
$sel:templateId:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:tags:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text Text)
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:keys:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text [ObjectTypeKey])
$sel:fields:PutProfileObjectType' :: PutProfileObjectType -> Maybe (HashMap Text ObjectTypeField)
$sel:expirationDays:PutProfileObjectType' :: PutProfileObjectType -> Maybe Natural
$sel:encryptionKey:PutProfileObjectType' :: PutProfileObjectType -> Maybe Text
$sel:allowProfileCreation:PutProfileObjectType' :: PutProfileObjectType -> Maybe Bool
..} =
    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 PutProfileObjectType where
  toQuery :: PutProfileObjectType -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'PutProfileObjectTypeResponse' 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', 'putProfileObjectTypeResponse_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', 'putProfileObjectTypeResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'encryptionKey', 'putProfileObjectTypeResponse_encryptionKey' - The customer-provided key to encrypt the profile object that will be
-- created in this profile object type.
--
-- 'expirationDays', 'putProfileObjectTypeResponse_expirationDays' - The number of days until the data in the object expires.
--
-- 'fields', 'putProfileObjectTypeResponse_fields' - A map of the name and ObjectType field.
--
-- 'keys', 'putProfileObjectTypeResponse_keys' - A list of unique keys that can be used to map data to the profile.
--
-- 'lastUpdatedAt', 'putProfileObjectTypeResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
--
-- 'sourceLastUpdatedTimestampFormat', 'putProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat' - The format of your @sourceLastUpdatedTimestamp@ that was previously set
-- up in fields that were parsed using
-- <https://docs.oracle.com/javase/10/docs/api/java/text/SimpleDateFormat.html SimpleDateFormat>.
-- If you have @sourceLastUpdatedTimestamp@ in your field, you must set up
-- @sourceLastUpdatedTimestampFormat@.
--
-- 'tags', 'putProfileObjectTypeResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'templateId', 'putProfileObjectTypeResponse_templateId' - A unique identifier for the object template.
--
-- 'httpStatus', 'putProfileObjectTypeResponse_httpStatus' - The response's http status code.
--
-- 'objectTypeName', 'putProfileObjectTypeResponse_objectTypeName' - The name of the profile object type.
--
-- 'description', 'putProfileObjectTypeResponse_description' - Description of the profile object type.
newPutProfileObjectTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'objectTypeName'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  PutProfileObjectTypeResponse
newPutProfileObjectTypeResponse :: Int -> Text -> Text -> PutProfileObjectTypeResponse
newPutProfileObjectTypeResponse
  Int
pHttpStatus_
  Text
pObjectTypeName_
  Text
pDescription_ =
    PutProfileObjectTypeResponse'
      { $sel:allowProfileCreation:PutProfileObjectTypeResponse' :: Maybe Bool
allowProfileCreation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:createdAt:PutProfileObjectTypeResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionKey:PutProfileObjectTypeResponse' :: Maybe Text
encryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:expirationDays:PutProfileObjectTypeResponse' :: Maybe Natural
expirationDays = forall a. Maybe a
Prelude.Nothing,
        $sel:fields:PutProfileObjectTypeResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = forall a. Maybe a
Prelude.Nothing,
        $sel:keys:PutProfileObjectTypeResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = forall a. Maybe a
Prelude.Nothing,
        $sel:lastUpdatedAt:PutProfileObjectTypeResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceLastUpdatedTimestampFormat:PutProfileObjectTypeResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutProfileObjectTypeResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:templateId:PutProfileObjectTypeResponse' :: Maybe Text
templateId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PutProfileObjectTypeResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:objectTypeName:PutProfileObjectTypeResponse' :: Text
objectTypeName = Text
pObjectTypeName_,
        $sel:description:PutProfileObjectTypeResponse' :: 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.
putProfileObjectTypeResponse_allowProfileCreation :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe Prelude.Bool)
putProfileObjectTypeResponse_allowProfileCreation :: Lens' PutProfileObjectTypeResponse (Maybe Bool)
putProfileObjectTypeResponse_allowProfileCreation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe Bool
allowProfileCreation :: Maybe Bool
$sel:allowProfileCreation:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse -> Maybe Bool
allowProfileCreation} -> Maybe Bool
allowProfileCreation) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe Bool
a -> PutProfileObjectTypeResponse
s {$sel:allowProfileCreation:PutProfileObjectTypeResponse' :: Maybe Bool
allowProfileCreation = Maybe Bool
a} :: PutProfileObjectTypeResponse)

-- | The timestamp of when the domain was created.
putProfileObjectTypeResponse_createdAt :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe Prelude.UTCTime)
putProfileObjectTypeResponse_createdAt :: Lens' PutProfileObjectTypeResponse (Maybe UTCTime)
putProfileObjectTypeResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe POSIX
a -> PutProfileObjectTypeResponse
s {$sel:createdAt:PutProfileObjectTypeResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: PutProfileObjectTypeResponse) 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.
putProfileObjectTypeResponse_encryptionKey :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe Prelude.Text)
putProfileObjectTypeResponse_encryptionKey :: Lens' PutProfileObjectTypeResponse (Maybe Text)
putProfileObjectTypeResponse_encryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe Text
encryptionKey :: Maybe Text
$sel:encryptionKey:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse -> Maybe Text
encryptionKey} -> Maybe Text
encryptionKey) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe Text
a -> PutProfileObjectTypeResponse
s {$sel:encryptionKey:PutProfileObjectTypeResponse' :: Maybe Text
encryptionKey = Maybe Text
a} :: PutProfileObjectTypeResponse)

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

-- | A map of the name and ObjectType field.
putProfileObjectTypeResponse_fields :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text ObjectTypeField))
putProfileObjectTypeResponse_fields :: Lens'
  PutProfileObjectTypeResponse (Maybe (HashMap Text ObjectTypeField))
putProfileObjectTypeResponse_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe (HashMap Text ObjectTypeField)
fields :: Maybe (HashMap Text ObjectTypeField)
$sel:fields:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse
-> Maybe (HashMap Text ObjectTypeField)
fields} -> Maybe (HashMap Text ObjectTypeField)
fields) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe (HashMap Text ObjectTypeField)
a -> PutProfileObjectTypeResponse
s {$sel:fields:PutProfileObjectTypeResponse' :: Maybe (HashMap Text ObjectTypeField)
fields = Maybe (HashMap Text ObjectTypeField)
a} :: PutProfileObjectTypeResponse) 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.
putProfileObjectTypeResponse_keys :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [ObjectTypeKey]))
putProfileObjectTypeResponse_keys :: Lens'
  PutProfileObjectTypeResponse (Maybe (HashMap Text [ObjectTypeKey]))
putProfileObjectTypeResponse_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe (HashMap Text [ObjectTypeKey])
keys :: Maybe (HashMap Text [ObjectTypeKey])
$sel:keys:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse
-> Maybe (HashMap Text [ObjectTypeKey])
keys} -> Maybe (HashMap Text [ObjectTypeKey])
keys) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe (HashMap Text [ObjectTypeKey])
a -> PutProfileObjectTypeResponse
s {$sel:keys:PutProfileObjectTypeResponse' :: Maybe (HashMap Text [ObjectTypeKey])
keys = Maybe (HashMap Text [ObjectTypeKey])
a} :: PutProfileObjectTypeResponse) 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.
putProfileObjectTypeResponse_lastUpdatedAt :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe Prelude.UTCTime)
putProfileObjectTypeResponse_lastUpdatedAt :: Lens' PutProfileObjectTypeResponse (Maybe UTCTime)
putProfileObjectTypeResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe POSIX
a -> PutProfileObjectTypeResponse
s {$sel:lastUpdatedAt:PutProfileObjectTypeResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: PutProfileObjectTypeResponse) 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 in fields that were parsed using
-- <https://docs.oracle.com/javase/10/docs/api/java/text/SimpleDateFormat.html SimpleDateFormat>.
-- If you have @sourceLastUpdatedTimestamp@ in your field, you must set up
-- @sourceLastUpdatedTimestampFormat@.
putProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat :: Lens.Lens' PutProfileObjectTypeResponse (Prelude.Maybe Prelude.Text)
putProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat :: Lens' PutProfileObjectTypeResponse (Maybe Text)
putProfileObjectTypeResponse_sourceLastUpdatedTimestampFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectTypeResponse' {Maybe Text
sourceLastUpdatedTimestampFormat :: Maybe Text
$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectTypeResponse' :: PutProfileObjectTypeResponse -> Maybe Text
sourceLastUpdatedTimestampFormat} -> Maybe Text
sourceLastUpdatedTimestampFormat) (\s :: PutProfileObjectTypeResponse
s@PutProfileObjectTypeResponse' {} Maybe Text
a -> PutProfileObjectTypeResponse
s {$sel:sourceLastUpdatedTimestampFormat:PutProfileObjectTypeResponse' :: Maybe Text
sourceLastUpdatedTimestampFormat = Maybe Text
a} :: PutProfileObjectTypeResponse)

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

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

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

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

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