{-# 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.PutIntegration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds an integration between the service and a third-party service, which
-- includes Amazon AppFlow and Amazon Connect.
--
-- An integration can belong to only one domain.
--
-- To add or remove tags on an existing Integration, 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.PutIntegration
  ( -- * Creating a Request
    PutIntegration (..),
    newPutIntegration,

    -- * Request Lenses
    putIntegration_flowDefinition,
    putIntegration_objectTypeName,
    putIntegration_objectTypeNames,
    putIntegration_tags,
    putIntegration_uri,
    putIntegration_domainName,

    -- * Destructuring the Response
    PutIntegrationResponse (..),
    newPutIntegrationResponse,

    -- * Response Lenses
    putIntegrationResponse_isUnstructured,
    putIntegrationResponse_objectTypeName,
    putIntegrationResponse_objectTypeNames,
    putIntegrationResponse_tags,
    putIntegrationResponse_workflowId,
    putIntegrationResponse_httpStatus,
    putIntegrationResponse_domainName,
    putIntegrationResponse_uri,
    putIntegrationResponse_createdAt,
    putIntegrationResponse_lastUpdatedAt,
  )
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:/ 'newPutIntegration' smart constructor.
data PutIntegration = PutIntegration'
  { -- | The configuration that controls how Customer Profiles retrieves data
    -- from the source.
    PutIntegration -> Maybe FlowDefinition
flowDefinition :: Prelude.Maybe FlowDefinition,
    -- | The name of the profile object type.
    PutIntegration -> Maybe Text
objectTypeName :: Prelude.Maybe Prelude.Text,
    -- | A map in which each key is an event type from an external application
    -- such as Segment or Shopify, and each value is an @ObjectTypeName@
    -- (template) used to ingest the event. It supports the following event
    -- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
    -- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
    -- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
    -- @ShopifyUpdatedOrders@.
    PutIntegration -> Maybe (HashMap Text Text)
objectTypeNames :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The tags used to organize, track, or control access for this resource.
    PutIntegration -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The URI of the S3 bucket or any other type of data source.
    PutIntegration -> Maybe Text
uri :: Prelude.Maybe Prelude.Text,
    -- | The unique name of the domain.
    PutIntegration -> Text
domainName :: Prelude.Text
  }
  deriving (PutIntegration -> PutIntegration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutIntegration -> PutIntegration -> Bool
$c/= :: PutIntegration -> PutIntegration -> Bool
== :: PutIntegration -> PutIntegration -> Bool
$c== :: PutIntegration -> PutIntegration -> Bool
Prelude.Eq, ReadPrec [PutIntegration]
ReadPrec PutIntegration
Int -> ReadS PutIntegration
ReadS [PutIntegration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutIntegration]
$creadListPrec :: ReadPrec [PutIntegration]
readPrec :: ReadPrec PutIntegration
$creadPrec :: ReadPrec PutIntegration
readList :: ReadS [PutIntegration]
$creadList :: ReadS [PutIntegration]
readsPrec :: Int -> ReadS PutIntegration
$creadsPrec :: Int -> ReadS PutIntegration
Prelude.Read, Int -> PutIntegration -> ShowS
[PutIntegration] -> ShowS
PutIntegration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutIntegration] -> ShowS
$cshowList :: [PutIntegration] -> ShowS
show :: PutIntegration -> String
$cshow :: PutIntegration -> String
showsPrec :: Int -> PutIntegration -> ShowS
$cshowsPrec :: Int -> PutIntegration -> ShowS
Prelude.Show, forall x. Rep PutIntegration x -> PutIntegration
forall x. PutIntegration -> Rep PutIntegration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutIntegration x -> PutIntegration
$cfrom :: forall x. PutIntegration -> Rep PutIntegration x
Prelude.Generic)

-- |
-- Create a value of 'PutIntegration' 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:
--
-- 'flowDefinition', 'putIntegration_flowDefinition' - The configuration that controls how Customer Profiles retrieves data
-- from the source.
--
-- 'objectTypeName', 'putIntegration_objectTypeName' - The name of the profile object type.
--
-- 'objectTypeNames', 'putIntegration_objectTypeNames' - A map in which each key is an event type from an external application
-- such as Segment or Shopify, and each value is an @ObjectTypeName@
-- (template) used to ingest the event. It supports the following event
-- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
-- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
-- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
-- @ShopifyUpdatedOrders@.
--
-- 'tags', 'putIntegration_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'uri', 'putIntegration_uri' - The URI of the S3 bucket or any other type of data source.
--
-- 'domainName', 'putIntegration_domainName' - The unique name of the domain.
newPutIntegration ::
  -- | 'domainName'
  Prelude.Text ->
  PutIntegration
newPutIntegration :: Text -> PutIntegration
newPutIntegration Text
pDomainName_ =
  PutIntegration'
    { $sel:flowDefinition:PutIntegration' :: Maybe FlowDefinition
flowDefinition = forall a. Maybe a
Prelude.Nothing,
      $sel:objectTypeName:PutIntegration' :: Maybe Text
objectTypeName = forall a. Maybe a
Prelude.Nothing,
      $sel:objectTypeNames:PutIntegration' :: Maybe (HashMap Text Text)
objectTypeNames = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:PutIntegration' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:uri:PutIntegration' :: Maybe Text
uri = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:PutIntegration' :: Text
domainName = Text
pDomainName_
    }

-- | The configuration that controls how Customer Profiles retrieves data
-- from the source.
putIntegration_flowDefinition :: Lens.Lens' PutIntegration (Prelude.Maybe FlowDefinition)
putIntegration_flowDefinition :: Lens' PutIntegration (Maybe FlowDefinition)
putIntegration_flowDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe FlowDefinition
flowDefinition :: Maybe FlowDefinition
$sel:flowDefinition:PutIntegration' :: PutIntegration -> Maybe FlowDefinition
flowDefinition} -> Maybe FlowDefinition
flowDefinition) (\s :: PutIntegration
s@PutIntegration' {} Maybe FlowDefinition
a -> PutIntegration
s {$sel:flowDefinition:PutIntegration' :: Maybe FlowDefinition
flowDefinition = Maybe FlowDefinition
a} :: PutIntegration)

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

-- | A map in which each key is an event type from an external application
-- such as Segment or Shopify, and each value is an @ObjectTypeName@
-- (template) used to ingest the event. It supports the following event
-- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
-- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
-- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
-- @ShopifyUpdatedOrders@.
putIntegration_objectTypeNames :: Lens.Lens' PutIntegration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegration_objectTypeNames :: Lens' PutIntegration (Maybe (HashMap Text Text))
putIntegration_objectTypeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
objectTypeNames} -> Maybe (HashMap Text Text)
objectTypeNames) (\s :: PutIntegration
s@PutIntegration' {} Maybe (HashMap Text Text)
a -> PutIntegration
s {$sel:objectTypeNames:PutIntegration' :: Maybe (HashMap Text Text)
objectTypeNames = Maybe (HashMap Text Text)
a} :: PutIntegration) 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 tags used to organize, track, or control access for this resource.
putIntegration_tags :: Lens.Lens' PutIntegration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegration_tags :: Lens' PutIntegration (Maybe (HashMap Text Text))
putIntegration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutIntegration
s@PutIntegration' {} Maybe (HashMap Text Text)
a -> PutIntegration
s {$sel:tags:PutIntegration' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutIntegration) 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 URI of the S3 bucket or any other type of data source.
putIntegration_uri :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_uri :: Lens' PutIntegration (Maybe Text)
putIntegration_uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
uri :: Maybe Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
uri} -> Maybe Text
uri) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:uri:PutIntegration' :: Maybe Text
uri = Maybe Text
a} :: PutIntegration)

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

instance Core.AWSRequest PutIntegration where
  type
    AWSResponse PutIntegration =
      PutIntegrationResponse
  request :: (Service -> Service) -> PutIntegration -> Request PutIntegration
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 PutIntegration
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutIntegration)))
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 Text
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Int
-> Text
-> Text
-> POSIX
-> POSIX
-> PutIntegrationResponse
PutIntegrationResponse'
            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
"IsUnstructured")
            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
"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 (Maybe a)
Data..?> Key
"ObjectTypeNames"
                            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
"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
"WorkflowId")
            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
"DomainName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Uri")
            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
"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 a
Data..:> Key
"LastUpdatedAt")
      )

instance Prelude.Hashable PutIntegration where
  hashWithSalt :: Int -> PutIntegration -> Int
hashWithSalt Int
_salt PutIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe FlowDefinition
Text
domainName :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
objectTypeName :: Maybe Text
flowDefinition :: Maybe FlowDefinition
$sel:domainName:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tags:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeName:PutIntegration' :: PutIntegration -> Maybe Text
$sel:flowDefinition:PutIntegration' :: PutIntegration -> Maybe FlowDefinition
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FlowDefinition
flowDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
objectTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
objectTypeNames
      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
uri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData PutIntegration where
  rnf :: PutIntegration -> ()
rnf PutIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe FlowDefinition
Text
domainName :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
objectTypeName :: Maybe Text
flowDefinition :: Maybe FlowDefinition
$sel:domainName:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tags:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeName:PutIntegration' :: PutIntegration -> Maybe Text
$sel:flowDefinition:PutIntegration' :: PutIntegration -> Maybe FlowDefinition
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FlowDefinition
flowDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
objectTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
objectTypeNames
      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
uri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders PutIntegration where
  toHeaders :: PutIntegration -> 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 PutIntegration where
  toJSON :: PutIntegration -> Value
toJSON PutIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe FlowDefinition
Text
domainName :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
objectTypeName :: Maybe Text
flowDefinition :: Maybe FlowDefinition
$sel:domainName:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tags:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeName:PutIntegration' :: PutIntegration -> Maybe Text
$sel:flowDefinition:PutIntegration' :: PutIntegration -> Maybe FlowDefinition
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FlowDefinition" 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 FlowDefinition
flowDefinition,
            (Key
"ObjectTypeName" 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
objectTypeName,
            (Key
"ObjectTypeNames" 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)
objectTypeNames,
            (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
"Uri" 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
uri
          ]
      )

instance Data.ToPath PutIntegration where
  toPath :: PutIntegration -> ByteString
toPath PutIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe FlowDefinition
Text
domainName :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
objectTypeName :: Maybe Text
flowDefinition :: Maybe FlowDefinition
$sel:domainName:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tags:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:objectTypeName:PutIntegration' :: PutIntegration -> Maybe Text
$sel:flowDefinition:PutIntegration' :: PutIntegration -> Maybe FlowDefinition
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName, ByteString
"/integrations"]

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

-- | /See:/ 'newPutIntegrationResponse' smart constructor.
data PutIntegrationResponse = PutIntegrationResponse'
  { -- | Boolean to indicate if the Flow associated with the Integration is
    -- created via Appflow console or with ObjectTypeName equals _unstructured
    -- via API\/CLI in flowDefinition
    PutIntegrationResponse -> Maybe Bool
isUnstructured :: Prelude.Maybe Prelude.Bool,
    -- | The name of the profile object type.
    PutIntegrationResponse -> Maybe Text
objectTypeName :: Prelude.Maybe Prelude.Text,
    -- | A map in which each key is an event type from an external application
    -- such as Segment or Shopify, and each value is an @ObjectTypeName@
    -- (template) used to ingest the event. It supports the following event
    -- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
    -- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
    -- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
    -- @ShopifyUpdatedOrders@.
    PutIntegrationResponse -> Maybe (HashMap Text Text)
objectTypeNames :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The tags used to organize, track, or control access for this resource.
    PutIntegrationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Unique identifier for the workflow.
    PutIntegrationResponse -> Maybe Text
workflowId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutIntegrationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique name of the domain.
    PutIntegrationResponse -> Text
domainName :: Prelude.Text,
    -- | The URI of the S3 bucket or any other type of data source.
    PutIntegrationResponse -> Text
uri :: Prelude.Text,
    -- | The timestamp of when the domain was created.
    PutIntegrationResponse -> POSIX
createdAt :: Data.POSIX,
    -- | The timestamp of when the domain was most recently edited.
    PutIntegrationResponse -> POSIX
lastUpdatedAt :: Data.POSIX
  }
  deriving (PutIntegrationResponse -> PutIntegrationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
$c/= :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
== :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
$c== :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
Prelude.Eq, ReadPrec [PutIntegrationResponse]
ReadPrec PutIntegrationResponse
Int -> ReadS PutIntegrationResponse
ReadS [PutIntegrationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutIntegrationResponse]
$creadListPrec :: ReadPrec [PutIntegrationResponse]
readPrec :: ReadPrec PutIntegrationResponse
$creadPrec :: ReadPrec PutIntegrationResponse
readList :: ReadS [PutIntegrationResponse]
$creadList :: ReadS [PutIntegrationResponse]
readsPrec :: Int -> ReadS PutIntegrationResponse
$creadsPrec :: Int -> ReadS PutIntegrationResponse
Prelude.Read, Int -> PutIntegrationResponse -> ShowS
[PutIntegrationResponse] -> ShowS
PutIntegrationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutIntegrationResponse] -> ShowS
$cshowList :: [PutIntegrationResponse] -> ShowS
show :: PutIntegrationResponse -> String
$cshow :: PutIntegrationResponse -> String
showsPrec :: Int -> PutIntegrationResponse -> ShowS
$cshowsPrec :: Int -> PutIntegrationResponse -> ShowS
Prelude.Show, forall x. Rep PutIntegrationResponse x -> PutIntegrationResponse
forall x. PutIntegrationResponse -> Rep PutIntegrationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutIntegrationResponse x -> PutIntegrationResponse
$cfrom :: forall x. PutIntegrationResponse -> Rep PutIntegrationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutIntegrationResponse' 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:
--
-- 'isUnstructured', 'putIntegrationResponse_isUnstructured' - Boolean to indicate if the Flow associated with the Integration is
-- created via Appflow console or with ObjectTypeName equals _unstructured
-- via API\/CLI in flowDefinition
--
-- 'objectTypeName', 'putIntegrationResponse_objectTypeName' - The name of the profile object type.
--
-- 'objectTypeNames', 'putIntegrationResponse_objectTypeNames' - A map in which each key is an event type from an external application
-- such as Segment or Shopify, and each value is an @ObjectTypeName@
-- (template) used to ingest the event. It supports the following event
-- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
-- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
-- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
-- @ShopifyUpdatedOrders@.
--
-- 'tags', 'putIntegrationResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'workflowId', 'putIntegrationResponse_workflowId' - Unique identifier for the workflow.
--
-- 'httpStatus', 'putIntegrationResponse_httpStatus' - The response's http status code.
--
-- 'domainName', 'putIntegrationResponse_domainName' - The unique name of the domain.
--
-- 'uri', 'putIntegrationResponse_uri' - The URI of the S3 bucket or any other type of data source.
--
-- 'createdAt', 'putIntegrationResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'lastUpdatedAt', 'putIntegrationResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
newPutIntegrationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainName'
  Prelude.Text ->
  -- | 'uri'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'lastUpdatedAt'
  Prelude.UTCTime ->
  PutIntegrationResponse
newPutIntegrationResponse :: Int -> Text -> Text -> UTCTime -> UTCTime -> PutIntegrationResponse
newPutIntegrationResponse
  Int
pHttpStatus_
  Text
pDomainName_
  Text
pUri_
  UTCTime
pCreatedAt_
  UTCTime
pLastUpdatedAt_ =
    PutIntegrationResponse'
      { $sel:isUnstructured:PutIntegrationResponse' :: Maybe Bool
isUnstructured =
          forall a. Maybe a
Prelude.Nothing,
        $sel:objectTypeName:PutIntegrationResponse' :: Maybe Text
objectTypeName = forall a. Maybe a
Prelude.Nothing,
        $sel:objectTypeNames:PutIntegrationResponse' :: Maybe (HashMap Text Text)
objectTypeNames = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutIntegrationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workflowId:PutIntegrationResponse' :: Maybe Text
workflowId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PutIntegrationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:domainName:PutIntegrationResponse' :: Text
domainName = Text
pDomainName_,
        $sel:uri:PutIntegrationResponse' :: Text
uri = Text
pUri_,
        $sel:createdAt:PutIntegrationResponse' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:lastUpdatedAt:PutIntegrationResponse' :: POSIX
lastUpdatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastUpdatedAt_
      }

-- | Boolean to indicate if the Flow associated with the Integration is
-- created via Appflow console or with ObjectTypeName equals _unstructured
-- via API\/CLI in flowDefinition
putIntegrationResponse_isUnstructured :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe Prelude.Bool)
putIntegrationResponse_isUnstructured :: Lens' PutIntegrationResponse (Maybe Bool)
putIntegrationResponse_isUnstructured = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe Bool
isUnstructured :: Maybe Bool
$sel:isUnstructured:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Bool
isUnstructured} -> Maybe Bool
isUnstructured) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe Bool
a -> PutIntegrationResponse
s {$sel:isUnstructured:PutIntegrationResponse' :: Maybe Bool
isUnstructured = Maybe Bool
a} :: PutIntegrationResponse)

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

-- | A map in which each key is an event type from an external application
-- such as Segment or Shopify, and each value is an @ObjectTypeName@
-- (template) used to ingest the event. It supports the following event
-- types: @SegmentIdentify@, @ShopifyCreateCustomers@,
-- @ShopifyUpdateCustomers@, @ShopifyCreateDraftOrders@,
-- @ShopifyUpdateDraftOrders@, @ShopifyCreateOrders@, and
-- @ShopifyUpdatedOrders@.
putIntegrationResponse_objectTypeNames :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegrationResponse_objectTypeNames :: Lens' PutIntegrationResponse (Maybe (HashMap Text Text))
putIntegrationResponse_objectTypeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
objectTypeNames} -> Maybe (HashMap Text Text)
objectTypeNames) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe (HashMap Text Text)
a -> PutIntegrationResponse
s {$sel:objectTypeNames:PutIntegrationResponse' :: Maybe (HashMap Text Text)
objectTypeNames = Maybe (HashMap Text Text)
a} :: PutIntegrationResponse) 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 tags used to organize, track, or control access for this resource.
putIntegrationResponse_tags :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegrationResponse_tags :: Lens' PutIntegrationResponse (Maybe (HashMap Text Text))
putIntegrationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe (HashMap Text Text)
a -> PutIntegrationResponse
s {$sel:tags:PutIntegrationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutIntegrationResponse) 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

-- | Unique identifier for the workflow.
putIntegrationResponse_workflowId :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe Prelude.Text)
putIntegrationResponse_workflowId :: Lens' PutIntegrationResponse (Maybe Text)
putIntegrationResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe Text
workflowId :: Maybe Text
$sel:workflowId:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
workflowId} -> Maybe Text
workflowId) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe Text
a -> PutIntegrationResponse
s {$sel:workflowId:PutIntegrationResponse' :: Maybe Text
workflowId = Maybe Text
a} :: PutIntegrationResponse)

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

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

-- | The URI of the S3 bucket or any other type of data source.
putIntegrationResponse_uri :: Lens.Lens' PutIntegrationResponse Prelude.Text
putIntegrationResponse_uri :: Lens' PutIntegrationResponse Text
putIntegrationResponse_uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Text
uri :: Text
$sel:uri:PutIntegrationResponse' :: PutIntegrationResponse -> Text
uri} -> Text
uri) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Text
a -> PutIntegrationResponse
s {$sel:uri:PutIntegrationResponse' :: Text
uri = Text
a} :: PutIntegrationResponse)

-- | The timestamp of when the domain was created.
putIntegrationResponse_createdAt :: Lens.Lens' PutIntegrationResponse Prelude.UTCTime
putIntegrationResponse_createdAt :: Lens' PutIntegrationResponse UTCTime
putIntegrationResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {POSIX
createdAt :: POSIX
$sel:createdAt:PutIntegrationResponse' :: PutIntegrationResponse -> POSIX
createdAt} -> POSIX
createdAt) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} POSIX
a -> PutIntegrationResponse
s {$sel:createdAt:PutIntegrationResponse' :: POSIX
createdAt = POSIX
a} :: PutIntegrationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The timestamp of when the domain was most recently edited.
putIntegrationResponse_lastUpdatedAt :: Lens.Lens' PutIntegrationResponse Prelude.UTCTime
putIntegrationResponse_lastUpdatedAt :: Lens' PutIntegrationResponse UTCTime
putIntegrationResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {POSIX
lastUpdatedAt :: POSIX
$sel:lastUpdatedAt:PutIntegrationResponse' :: PutIntegrationResponse -> POSIX
lastUpdatedAt} -> POSIX
lastUpdatedAt) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} POSIX
a -> PutIntegrationResponse
s {$sel:lastUpdatedAt:PutIntegrationResponse' :: POSIX
lastUpdatedAt = POSIX
a} :: PutIntegrationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData PutIntegrationResponse where
  rnf :: PutIntegrationResponse -> ()
rnf PutIntegrationResponse' {Int
Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
lastUpdatedAt :: POSIX
createdAt :: POSIX
uri :: Text
domainName :: Text
httpStatus :: Int
workflowId :: Maybe Text
tags :: Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
objectTypeName :: Maybe Text
isUnstructured :: Maybe Bool
$sel:lastUpdatedAt:PutIntegrationResponse' :: PutIntegrationResponse -> POSIX
$sel:createdAt:PutIntegrationResponse' :: PutIntegrationResponse -> POSIX
$sel:uri:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:domainName:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:httpStatus:PutIntegrationResponse' :: PutIntegrationResponse -> Int
$sel:workflowId:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:tags:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:objectTypeNames:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:objectTypeName:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:isUnstructured:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isUnstructured
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
objectTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
objectTypeNames
      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
workflowId
      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
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastUpdatedAt