{-# 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.GetIntegration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns an integration for a domain.
module Amazonka.CustomerProfiles.GetIntegration
  ( -- * Creating a Request
    GetIntegration (..),
    newGetIntegration,

    -- * Request Lenses
    getIntegration_domainName,
    getIntegration_uri,

    -- * Destructuring the Response
    GetIntegrationResponse (..),
    newGetIntegrationResponse,

    -- * Response Lenses
    getIntegrationResponse_isUnstructured,
    getIntegrationResponse_objectTypeName,
    getIntegrationResponse_objectTypeNames,
    getIntegrationResponse_tags,
    getIntegrationResponse_workflowId,
    getIntegrationResponse_httpStatus,
    getIntegrationResponse_domainName,
    getIntegrationResponse_uri,
    getIntegrationResponse_createdAt,
    getIntegrationResponse_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:/ 'newGetIntegration' smart constructor.
data GetIntegration = GetIntegration'
  { -- | The unique name of the domain.
    GetIntegration -> Text
domainName :: Prelude.Text,
    -- | The URI of the S3 bucket or any other type of data source.
    GetIntegration -> Text
uri :: Prelude.Text
  }
  deriving (GetIntegration -> GetIntegration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIntegration -> GetIntegration -> Bool
$c/= :: GetIntegration -> GetIntegration -> Bool
== :: GetIntegration -> GetIntegration -> Bool
$c== :: GetIntegration -> GetIntegration -> Bool
Prelude.Eq, ReadPrec [GetIntegration]
ReadPrec GetIntegration
Int -> ReadS GetIntegration
ReadS [GetIntegration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIntegration]
$creadListPrec :: ReadPrec [GetIntegration]
readPrec :: ReadPrec GetIntegration
$creadPrec :: ReadPrec GetIntegration
readList :: ReadS [GetIntegration]
$creadList :: ReadS [GetIntegration]
readsPrec :: Int -> ReadS GetIntegration
$creadsPrec :: Int -> ReadS GetIntegration
Prelude.Read, Int -> GetIntegration -> ShowS
[GetIntegration] -> ShowS
GetIntegration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIntegration] -> ShowS
$cshowList :: [GetIntegration] -> ShowS
show :: GetIntegration -> String
$cshow :: GetIntegration -> String
showsPrec :: Int -> GetIntegration -> ShowS
$cshowsPrec :: Int -> GetIntegration -> ShowS
Prelude.Show, forall x. Rep GetIntegration x -> GetIntegration
forall x. GetIntegration -> Rep GetIntegration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetIntegration x -> GetIntegration
$cfrom :: forall x. GetIntegration -> Rep GetIntegration x
Prelude.Generic)

-- |
-- Create a value of 'GetIntegration' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'domainName', 'getIntegration_domainName' - The unique name of the domain.
--
-- 'uri', 'getIntegration_uri' - The URI of the S3 bucket or any other type of data source.
newGetIntegration ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'uri'
  Prelude.Text ->
  GetIntegration
newGetIntegration :: Text -> Text -> GetIntegration
newGetIntegration Text
pDomainName_ Text
pUri_ =
  GetIntegration'
    { $sel:domainName:GetIntegration' :: Text
domainName = Text
pDomainName_,
      $sel:uri:GetIntegration' :: Text
uri = Text
pUri_
    }

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

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

instance Core.AWSRequest GetIntegration where
  type
    AWSResponse GetIntegration =
      GetIntegrationResponse
  request :: (Service -> Service) -> GetIntegration -> Request GetIntegration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetIntegration
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetIntegration)))
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
-> GetIntegrationResponse
GetIntegrationResponse'
            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 GetIntegration where
  hashWithSalt :: Int -> GetIntegration -> Int
hashWithSalt Int
_salt GetIntegration' {Text
uri :: Text
domainName :: Text
$sel:uri:GetIntegration' :: GetIntegration -> Text
$sel:domainName:GetIntegration' :: GetIntegration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uri

instance Prelude.NFData GetIntegration where
  rnf :: GetIntegration -> ()
rnf GetIntegration' {Text
uri :: Text
domainName :: Text
$sel:uri:GetIntegration' :: GetIntegration -> Text
$sel:domainName:GetIntegration' :: GetIntegration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uri

instance Data.ToHeaders GetIntegration where
  toHeaders :: GetIntegration -> 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 GetIntegration where
  toJSON :: GetIntegration -> Value
toJSON GetIntegration' {Text
uri :: Text
domainName :: Text
$sel:uri:GetIntegration' :: GetIntegration -> Text
$sel:domainName:GetIntegration' :: GetIntegration -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
uri)]
      )

instance Data.ToPath GetIntegration where
  toPath :: GetIntegration -> ByteString
toPath GetIntegration' {Text
uri :: Text
domainName :: Text
$sel:uri:GetIntegration' :: GetIntegration -> Text
$sel:domainName:GetIntegration' :: GetIntegration -> Text
..} =
    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 GetIntegration where
  toQuery :: GetIntegration -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetIntegrationResponse' smart constructor.
data GetIntegrationResponse = GetIntegrationResponse'
  { -- | 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
    GetIntegrationResponse -> Maybe Bool
isUnstructured :: Prelude.Maybe Prelude.Bool,
    -- | The name of the profile object type.
    GetIntegrationResponse -> 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@.
    GetIntegrationResponse -> 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.
    GetIntegrationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Unique identifier for the workflow.
    GetIntegrationResponse -> Maybe Text
workflowId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetIntegrationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique name of the domain.
    GetIntegrationResponse -> Text
domainName :: Prelude.Text,
    -- | The URI of the S3 bucket or any other type of data source.
    GetIntegrationResponse -> Text
uri :: Prelude.Text,
    -- | The timestamp of when the domain was created.
    GetIntegrationResponse -> POSIX
createdAt :: Data.POSIX,
    -- | The timestamp of when the domain was most recently edited.
    GetIntegrationResponse -> POSIX
lastUpdatedAt :: Data.POSIX
  }
  deriving (GetIntegrationResponse -> GetIntegrationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIntegrationResponse -> GetIntegrationResponse -> Bool
$c/= :: GetIntegrationResponse -> GetIntegrationResponse -> Bool
== :: GetIntegrationResponse -> GetIntegrationResponse -> Bool
$c== :: GetIntegrationResponse -> GetIntegrationResponse -> Bool
Prelude.Eq, ReadPrec [GetIntegrationResponse]
ReadPrec GetIntegrationResponse
Int -> ReadS GetIntegrationResponse
ReadS [GetIntegrationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIntegrationResponse]
$creadListPrec :: ReadPrec [GetIntegrationResponse]
readPrec :: ReadPrec GetIntegrationResponse
$creadPrec :: ReadPrec GetIntegrationResponse
readList :: ReadS [GetIntegrationResponse]
$creadList :: ReadS [GetIntegrationResponse]
readsPrec :: Int -> ReadS GetIntegrationResponse
$creadsPrec :: Int -> ReadS GetIntegrationResponse
Prelude.Read, Int -> GetIntegrationResponse -> ShowS
[GetIntegrationResponse] -> ShowS
GetIntegrationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIntegrationResponse] -> ShowS
$cshowList :: [GetIntegrationResponse] -> ShowS
show :: GetIntegrationResponse -> String
$cshow :: GetIntegrationResponse -> String
showsPrec :: Int -> GetIntegrationResponse -> ShowS
$cshowsPrec :: Int -> GetIntegrationResponse -> ShowS
Prelude.Show, forall x. Rep GetIntegrationResponse x -> GetIntegrationResponse
forall x. GetIntegrationResponse -> Rep GetIntegrationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetIntegrationResponse x -> GetIntegrationResponse
$cfrom :: forall x. GetIntegrationResponse -> Rep GetIntegrationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIntegrationResponse' 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', 'getIntegrationResponse_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', 'getIntegrationResponse_objectTypeName' - The name of the profile object type.
--
-- 'objectTypeNames', 'getIntegrationResponse_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', 'getIntegrationResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'workflowId', 'getIntegrationResponse_workflowId' - Unique identifier for the workflow.
--
-- 'httpStatus', 'getIntegrationResponse_httpStatus' - The response's http status code.
--
-- 'domainName', 'getIntegrationResponse_domainName' - The unique name of the domain.
--
-- 'uri', 'getIntegrationResponse_uri' - The URI of the S3 bucket or any other type of data source.
--
-- 'createdAt', 'getIntegrationResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'lastUpdatedAt', 'getIntegrationResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
newGetIntegrationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainName'
  Prelude.Text ->
  -- | 'uri'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'lastUpdatedAt'
  Prelude.UTCTime ->
  GetIntegrationResponse
newGetIntegrationResponse :: Int -> Text -> Text -> UTCTime -> UTCTime -> GetIntegrationResponse
newGetIntegrationResponse
  Int
pHttpStatus_
  Text
pDomainName_
  Text
pUri_
  UTCTime
pCreatedAt_
  UTCTime
pLastUpdatedAt_ =
    GetIntegrationResponse'
      { $sel:isUnstructured:GetIntegrationResponse' :: Maybe Bool
isUnstructured =
          forall a. Maybe a
Prelude.Nothing,
        $sel:objectTypeName:GetIntegrationResponse' :: Maybe Text
objectTypeName = forall a. Maybe a
Prelude.Nothing,
        $sel:objectTypeNames:GetIntegrationResponse' :: Maybe (HashMap Text Text)
objectTypeNames = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetIntegrationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workflowId:GetIntegrationResponse' :: Maybe Text
workflowId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetIntegrationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:domainName:GetIntegrationResponse' :: Text
domainName = Text
pDomainName_,
        $sel:uri:GetIntegrationResponse' :: Text
uri = Text
pUri_,
        $sel:createdAt:GetIntegrationResponse' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:lastUpdatedAt:GetIntegrationResponse' :: 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
getIntegrationResponse_isUnstructured :: Lens.Lens' GetIntegrationResponse (Prelude.Maybe Prelude.Bool)
getIntegrationResponse_isUnstructured :: Lens' GetIntegrationResponse (Maybe Bool)
getIntegrationResponse_isUnstructured = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {Maybe Bool
isUnstructured :: Maybe Bool
$sel:isUnstructured:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe Bool
isUnstructured} -> Maybe Bool
isUnstructured) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} Maybe Bool
a -> GetIntegrationResponse
s {$sel:isUnstructured:GetIntegrationResponse' :: Maybe Bool
isUnstructured = Maybe Bool
a} :: GetIntegrationResponse)

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

-- | 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@.
getIntegrationResponse_objectTypeNames :: Lens.Lens' GetIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getIntegrationResponse_objectTypeNames :: Lens' GetIntegrationResponse (Maybe (HashMap Text Text))
getIntegrationResponse_objectTypeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {Maybe (HashMap Text Text)
objectTypeNames :: Maybe (HashMap Text Text)
$sel:objectTypeNames:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe (HashMap Text Text)
objectTypeNames} -> Maybe (HashMap Text Text)
objectTypeNames) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} Maybe (HashMap Text Text)
a -> GetIntegrationResponse
s {$sel:objectTypeNames:GetIntegrationResponse' :: Maybe (HashMap Text Text)
objectTypeNames = Maybe (HashMap Text Text)
a} :: GetIntegrationResponse) 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.
getIntegrationResponse_tags :: Lens.Lens' GetIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getIntegrationResponse_tags :: Lens' GetIntegrationResponse (Maybe (HashMap Text Text))
getIntegrationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} Maybe (HashMap Text Text)
a -> GetIntegrationResponse
s {$sel:tags:GetIntegrationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetIntegrationResponse) 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.
getIntegrationResponse_workflowId :: Lens.Lens' GetIntegrationResponse (Prelude.Maybe Prelude.Text)
getIntegrationResponse_workflowId :: Lens' GetIntegrationResponse (Maybe Text)
getIntegrationResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {Maybe Text
workflowId :: Maybe Text
$sel:workflowId:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe Text
workflowId} -> Maybe Text
workflowId) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} Maybe Text
a -> GetIntegrationResponse
s {$sel:workflowId:GetIntegrationResponse' :: Maybe Text
workflowId = Maybe Text
a} :: GetIntegrationResponse)

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

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

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

-- | The timestamp of when the domain was created.
getIntegrationResponse_createdAt :: Lens.Lens' GetIntegrationResponse Prelude.UTCTime
getIntegrationResponse_createdAt :: Lens' GetIntegrationResponse UTCTime
getIntegrationResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {POSIX
createdAt :: POSIX
$sel:createdAt:GetIntegrationResponse' :: GetIntegrationResponse -> POSIX
createdAt} -> POSIX
createdAt) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} POSIX
a -> GetIntegrationResponse
s {$sel:createdAt:GetIntegrationResponse' :: POSIX
createdAt = POSIX
a} :: GetIntegrationResponse) 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.
getIntegrationResponse_lastUpdatedAt :: Lens.Lens' GetIntegrationResponse Prelude.UTCTime
getIntegrationResponse_lastUpdatedAt :: Lens' GetIntegrationResponse UTCTime
getIntegrationResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntegrationResponse' {POSIX
lastUpdatedAt :: POSIX
$sel:lastUpdatedAt:GetIntegrationResponse' :: GetIntegrationResponse -> POSIX
lastUpdatedAt} -> POSIX
lastUpdatedAt) (\s :: GetIntegrationResponse
s@GetIntegrationResponse' {} POSIX
a -> GetIntegrationResponse
s {$sel:lastUpdatedAt:GetIntegrationResponse' :: POSIX
lastUpdatedAt = POSIX
a} :: GetIntegrationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData GetIntegrationResponse where
  rnf :: GetIntegrationResponse -> ()
rnf GetIntegrationResponse' {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:GetIntegrationResponse' :: GetIntegrationResponse -> POSIX
$sel:createdAt:GetIntegrationResponse' :: GetIntegrationResponse -> POSIX
$sel:uri:GetIntegrationResponse' :: GetIntegrationResponse -> Text
$sel:domainName:GetIntegrationResponse' :: GetIntegrationResponse -> Text
$sel:httpStatus:GetIntegrationResponse' :: GetIntegrationResponse -> Int
$sel:workflowId:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe Text
$sel:tags:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe (HashMap Text Text)
$sel:objectTypeNames:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe (HashMap Text Text)
$sel:objectTypeName:GetIntegrationResponse' :: GetIntegrationResponse -> Maybe Text
$sel:isUnstructured:GetIntegrationResponse' :: GetIntegrationResponse -> 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