{-# 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.AppIntegrationS.CreateDataIntegration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates and persists a DataIntegration resource.
--
-- You cannot create a DataIntegration association for a DataIntegration
-- that has been previously associated. Use a different DataIntegration, or
-- recreate the DataIntegration using the @CreateDataIntegration@ API.
module Amazonka.AppIntegrationS.CreateDataIntegration
  ( -- * Creating a Request
    CreateDataIntegration (..),
    newCreateDataIntegration,

    -- * Request Lenses
    createDataIntegration_clientToken,
    createDataIntegration_description,
    createDataIntegration_kmsKey,
    createDataIntegration_scheduleConfig,
    createDataIntegration_sourceURI,
    createDataIntegration_tags,
    createDataIntegration_name,

    -- * Destructuring the Response
    CreateDataIntegrationResponse (..),
    newCreateDataIntegrationResponse,

    -- * Response Lenses
    createDataIntegrationResponse_arn,
    createDataIntegrationResponse_clientToken,
    createDataIntegrationResponse_description,
    createDataIntegrationResponse_id,
    createDataIntegrationResponse_kmsKey,
    createDataIntegrationResponse_name,
    createDataIntegrationResponse_scheduleConfiguration,
    createDataIntegrationResponse_sourceURI,
    createDataIntegrationResponse_tags,
    createDataIntegrationResponse_httpStatus,
  )
where

import Amazonka.AppIntegrationS.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
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:/ 'newCreateDataIntegration' smart constructor.
data CreateDataIntegration = CreateDataIntegration'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateDataIntegration -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the DataIntegration.
    CreateDataIntegration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The KMS key for the DataIntegration.
    CreateDataIntegration -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | The name of the data and how often it should be pulled from the source.
    CreateDataIntegration -> Maybe ScheduleConfiguration
scheduleConfig :: Prelude.Maybe ScheduleConfiguration,
    -- | The URI of the data source.
    CreateDataIntegration -> Maybe Text
sourceURI :: Prelude.Maybe Prelude.Text,
    -- | One or more tags.
    CreateDataIntegration -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the DataIntegration.
    CreateDataIntegration -> Text
name :: Prelude.Text
  }
  deriving (CreateDataIntegration -> CreateDataIntegration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataIntegration -> CreateDataIntegration -> Bool
$c/= :: CreateDataIntegration -> CreateDataIntegration -> Bool
== :: CreateDataIntegration -> CreateDataIntegration -> Bool
$c== :: CreateDataIntegration -> CreateDataIntegration -> Bool
Prelude.Eq, ReadPrec [CreateDataIntegration]
ReadPrec CreateDataIntegration
Int -> ReadS CreateDataIntegration
ReadS [CreateDataIntegration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataIntegration]
$creadListPrec :: ReadPrec [CreateDataIntegration]
readPrec :: ReadPrec CreateDataIntegration
$creadPrec :: ReadPrec CreateDataIntegration
readList :: ReadS [CreateDataIntegration]
$creadList :: ReadS [CreateDataIntegration]
readsPrec :: Int -> ReadS CreateDataIntegration
$creadsPrec :: Int -> ReadS CreateDataIntegration
Prelude.Read, Int -> CreateDataIntegration -> ShowS
[CreateDataIntegration] -> ShowS
CreateDataIntegration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataIntegration] -> ShowS
$cshowList :: [CreateDataIntegration] -> ShowS
show :: CreateDataIntegration -> String
$cshow :: CreateDataIntegration -> String
showsPrec :: Int -> CreateDataIntegration -> ShowS
$cshowsPrec :: Int -> CreateDataIntegration -> ShowS
Prelude.Show, forall x. Rep CreateDataIntegration x -> CreateDataIntegration
forall x. CreateDataIntegration -> Rep CreateDataIntegration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDataIntegration x -> CreateDataIntegration
$cfrom :: forall x. CreateDataIntegration -> Rep CreateDataIntegration x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataIntegration' 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:
--
-- 'clientToken', 'createDataIntegration_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createDataIntegration_description' - A description of the DataIntegration.
--
-- 'kmsKey', 'createDataIntegration_kmsKey' - The KMS key for the DataIntegration.
--
-- 'scheduleConfig', 'createDataIntegration_scheduleConfig' - The name of the data and how often it should be pulled from the source.
--
-- 'sourceURI', 'createDataIntegration_sourceURI' - The URI of the data source.
--
-- 'tags', 'createDataIntegration_tags' - One or more tags.
--
-- 'name', 'createDataIntegration_name' - The name of the DataIntegration.
newCreateDataIntegration ::
  -- | 'name'
  Prelude.Text ->
  CreateDataIntegration
newCreateDataIntegration :: Text -> CreateDataIntegration
newCreateDataIntegration Text
pName_ =
  CreateDataIntegration'
    { $sel:clientToken:CreateDataIntegration' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateDataIntegration' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKey:CreateDataIntegration' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleConfig:CreateDataIntegration' :: Maybe ScheduleConfiguration
scheduleConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceURI:CreateDataIntegration' :: Maybe Text
sourceURI = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDataIntegration' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateDataIntegration' :: Text
name = Text
pName_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createDataIntegration_clientToken :: Lens.Lens' CreateDataIntegration (Prelude.Maybe Prelude.Text)
createDataIntegration_clientToken :: Lens' CreateDataIntegration (Maybe Text)
createDataIntegration_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe Text
a -> CreateDataIntegration
s {$sel:clientToken:CreateDataIntegration' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDataIntegration)

-- | A description of the DataIntegration.
createDataIntegration_description :: Lens.Lens' CreateDataIntegration (Prelude.Maybe Prelude.Text)
createDataIntegration_description :: Lens' CreateDataIntegration (Maybe Text)
createDataIntegration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe Text
description :: Maybe Text
$sel:description:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe Text
a -> CreateDataIntegration
s {$sel:description:CreateDataIntegration' :: Maybe Text
description = Maybe Text
a} :: CreateDataIntegration)

-- | The KMS key for the DataIntegration.
createDataIntegration_kmsKey :: Lens.Lens' CreateDataIntegration (Prelude.Maybe Prelude.Text)
createDataIntegration_kmsKey :: Lens' CreateDataIntegration (Maybe Text)
createDataIntegration_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe Text
a -> CreateDataIntegration
s {$sel:kmsKey:CreateDataIntegration' :: Maybe Text
kmsKey = Maybe Text
a} :: CreateDataIntegration)

-- | The name of the data and how often it should be pulled from the source.
createDataIntegration_scheduleConfig :: Lens.Lens' CreateDataIntegration (Prelude.Maybe ScheduleConfiguration)
createDataIntegration_scheduleConfig :: Lens' CreateDataIntegration (Maybe ScheduleConfiguration)
createDataIntegration_scheduleConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe ScheduleConfiguration
scheduleConfig :: Maybe ScheduleConfiguration
$sel:scheduleConfig:CreateDataIntegration' :: CreateDataIntegration -> Maybe ScheduleConfiguration
scheduleConfig} -> Maybe ScheduleConfiguration
scheduleConfig) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe ScheduleConfiguration
a -> CreateDataIntegration
s {$sel:scheduleConfig:CreateDataIntegration' :: Maybe ScheduleConfiguration
scheduleConfig = Maybe ScheduleConfiguration
a} :: CreateDataIntegration)

-- | The URI of the data source.
createDataIntegration_sourceURI :: Lens.Lens' CreateDataIntegration (Prelude.Maybe Prelude.Text)
createDataIntegration_sourceURI :: Lens' CreateDataIntegration (Maybe Text)
createDataIntegration_sourceURI = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe Text
sourceURI :: Maybe Text
$sel:sourceURI:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
sourceURI} -> Maybe Text
sourceURI) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe Text
a -> CreateDataIntegration
s {$sel:sourceURI:CreateDataIntegration' :: Maybe Text
sourceURI = Maybe Text
a} :: CreateDataIntegration)

-- | One or more tags.
createDataIntegration_tags :: Lens.Lens' CreateDataIntegration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDataIntegration_tags :: Lens' CreateDataIntegration (Maybe (HashMap Text Text))
createDataIntegration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateDataIntegration' :: CreateDataIntegration -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Maybe (HashMap Text Text)
a -> CreateDataIntegration
s {$sel:tags:CreateDataIntegration' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateDataIntegration) 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 name of the DataIntegration.
createDataIntegration_name :: Lens.Lens' CreateDataIntegration Prelude.Text
createDataIntegration_name :: Lens' CreateDataIntegration Text
createDataIntegration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegration' {Text
name :: Text
$sel:name:CreateDataIntegration' :: CreateDataIntegration -> Text
name} -> Text
name) (\s :: CreateDataIntegration
s@CreateDataIntegration' {} Text
a -> CreateDataIntegration
s {$sel:name:CreateDataIntegration' :: Text
name = Text
a} :: CreateDataIntegration)

instance Core.AWSRequest CreateDataIntegration where
  type
    AWSResponse CreateDataIntegration =
      CreateDataIntegrationResponse
  request :: (Service -> Service)
-> CreateDataIntegration -> Request CreateDataIntegration
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 CreateDataIntegration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDataIntegration)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ScheduleConfiguration
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> CreateDataIntegrationResponse
CreateDataIntegrationResponse'
            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
"Arn")
            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
"ClientToken")
            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
"Description")
            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
"Id")
            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
"KmsKey")
            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
"Name")
            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
"ScheduleConfiguration")
            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
"SourceURI")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateDataIntegration where
  hashWithSalt :: Int -> CreateDataIntegration -> Int
hashWithSalt Int
_salt CreateDataIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduleConfiguration
Text
name :: Text
tags :: Maybe (HashMap Text Text)
sourceURI :: Maybe Text
scheduleConfig :: Maybe ScheduleConfiguration
kmsKey :: Maybe Text
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateDataIntegration' :: CreateDataIntegration -> Text
$sel:tags:CreateDataIntegration' :: CreateDataIntegration -> Maybe (HashMap Text Text)
$sel:sourceURI:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:scheduleConfig:CreateDataIntegration' :: CreateDataIntegration -> Maybe ScheduleConfiguration
$sel:kmsKey:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:description:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:clientToken:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScheduleConfiguration
scheduleConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceURI
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateDataIntegration where
  rnf :: CreateDataIntegration -> ()
rnf CreateDataIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduleConfiguration
Text
name :: Text
tags :: Maybe (HashMap Text Text)
sourceURI :: Maybe Text
scheduleConfig :: Maybe ScheduleConfiguration
kmsKey :: Maybe Text
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateDataIntegration' :: CreateDataIntegration -> Text
$sel:tags:CreateDataIntegration' :: CreateDataIntegration -> Maybe (HashMap Text Text)
$sel:sourceURI:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:scheduleConfig:CreateDataIntegration' :: CreateDataIntegration -> Maybe ScheduleConfiguration
$sel:kmsKey:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:description:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:clientToken:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ScheduleConfiguration
scheduleConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceURI
      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 Text
name

instance Data.ToHeaders CreateDataIntegration where
  toHeaders :: CreateDataIntegration -> 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 CreateDataIntegration where
  toJSON :: CreateDataIntegration -> Value
toJSON CreateDataIntegration' {Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduleConfiguration
Text
name :: Text
tags :: Maybe (HashMap Text Text)
sourceURI :: Maybe Text
scheduleConfig :: Maybe ScheduleConfiguration
kmsKey :: Maybe Text
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateDataIntegration' :: CreateDataIntegration -> Text
$sel:tags:CreateDataIntegration' :: CreateDataIntegration -> Maybe (HashMap Text Text)
$sel:sourceURI:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:scheduleConfig:CreateDataIntegration' :: CreateDataIntegration -> Maybe ScheduleConfiguration
$sel:kmsKey:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:description:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
$sel:clientToken:CreateDataIntegration' :: CreateDataIntegration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"Description" 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
description,
            (Key
"KmsKey" 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
kmsKey,
            (Key
"ScheduleConfig" 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 ScheduleConfiguration
scheduleConfig,
            (Key
"SourceURI" 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
sourceURI,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateDataIntegration where
  toPath :: CreateDataIntegration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/dataIntegrations"

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

-- | /See:/ 'newCreateDataIntegrationResponse' smart constructor.
data CreateDataIntegrationResponse = CreateDataIntegrationResponse'
  { -- | The Amazon Resource Name (ARN)
    CreateDataIntegrationResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateDataIntegrationResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the DataIntegration.
    CreateDataIntegrationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier.
    CreateDataIntegrationResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The KMS key for the DataIntegration.
    CreateDataIntegrationResponse -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | The name of the DataIntegration.
    CreateDataIntegrationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The name of the data and how often it should be pulled from the source.
    CreateDataIntegrationResponse -> Maybe ScheduleConfiguration
scheduleConfiguration :: Prelude.Maybe ScheduleConfiguration,
    -- | The URI of the data source.
    CreateDataIntegrationResponse -> Maybe Text
sourceURI :: Prelude.Maybe Prelude.Text,
    -- | One or more tags.
    CreateDataIntegrationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateDataIntegrationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDataIntegrationResponse
-> CreateDataIntegrationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataIntegrationResponse
-> CreateDataIntegrationResponse -> Bool
$c/= :: CreateDataIntegrationResponse
-> CreateDataIntegrationResponse -> Bool
== :: CreateDataIntegrationResponse
-> CreateDataIntegrationResponse -> Bool
$c== :: CreateDataIntegrationResponse
-> CreateDataIntegrationResponse -> Bool
Prelude.Eq, ReadPrec [CreateDataIntegrationResponse]
ReadPrec CreateDataIntegrationResponse
Int -> ReadS CreateDataIntegrationResponse
ReadS [CreateDataIntegrationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataIntegrationResponse]
$creadListPrec :: ReadPrec [CreateDataIntegrationResponse]
readPrec :: ReadPrec CreateDataIntegrationResponse
$creadPrec :: ReadPrec CreateDataIntegrationResponse
readList :: ReadS [CreateDataIntegrationResponse]
$creadList :: ReadS [CreateDataIntegrationResponse]
readsPrec :: Int -> ReadS CreateDataIntegrationResponse
$creadsPrec :: Int -> ReadS CreateDataIntegrationResponse
Prelude.Read, Int -> CreateDataIntegrationResponse -> ShowS
[CreateDataIntegrationResponse] -> ShowS
CreateDataIntegrationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataIntegrationResponse] -> ShowS
$cshowList :: [CreateDataIntegrationResponse] -> ShowS
show :: CreateDataIntegrationResponse -> String
$cshow :: CreateDataIntegrationResponse -> String
showsPrec :: Int -> CreateDataIntegrationResponse -> ShowS
$cshowsPrec :: Int -> CreateDataIntegrationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDataIntegrationResponse x
-> CreateDataIntegrationResponse
forall x.
CreateDataIntegrationResponse
-> Rep CreateDataIntegrationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDataIntegrationResponse x
-> CreateDataIntegrationResponse
$cfrom :: forall x.
CreateDataIntegrationResponse
-> Rep CreateDataIntegrationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataIntegrationResponse' 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:
--
-- 'arn', 'createDataIntegrationResponse_arn' - The Amazon Resource Name (ARN)
--
-- 'clientToken', 'createDataIntegrationResponse_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createDataIntegrationResponse_description' - A description of the DataIntegration.
--
-- 'id', 'createDataIntegrationResponse_id' - A unique identifier.
--
-- 'kmsKey', 'createDataIntegrationResponse_kmsKey' - The KMS key for the DataIntegration.
--
-- 'name', 'createDataIntegrationResponse_name' - The name of the DataIntegration.
--
-- 'scheduleConfiguration', 'createDataIntegrationResponse_scheduleConfiguration' - The name of the data and how often it should be pulled from the source.
--
-- 'sourceURI', 'createDataIntegrationResponse_sourceURI' - The URI of the data source.
--
-- 'tags', 'createDataIntegrationResponse_tags' - One or more tags.
--
-- 'httpStatus', 'createDataIntegrationResponse_httpStatus' - The response's http status code.
newCreateDataIntegrationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDataIntegrationResponse
newCreateDataIntegrationResponse :: Int -> CreateDataIntegrationResponse
newCreateDataIntegrationResponse Int
pHttpStatus_ =
  CreateDataIntegrationResponse'
    { $sel:arn:CreateDataIntegrationResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateDataIntegrationResponse' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateDataIntegrationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateDataIntegrationResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKey:CreateDataIntegrationResponse' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateDataIntegrationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleConfiguration:CreateDataIntegrationResponse' :: Maybe ScheduleConfiguration
scheduleConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceURI:CreateDataIntegrationResponse' :: Maybe Text
sourceURI = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDataIntegrationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDataIntegrationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN)
createDataIntegrationResponse_arn :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_arn :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:arn:CreateDataIntegrationResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createDataIntegrationResponse_clientToken :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_clientToken :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:clientToken:CreateDataIntegrationResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | A description of the DataIntegration.
createDataIntegrationResponse_description :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_description :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:description:CreateDataIntegrationResponse' :: Maybe Text
description = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | A unique identifier.
createDataIntegrationResponse_id :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_id :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:id:CreateDataIntegrationResponse' :: Maybe Text
id = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | The KMS key for the DataIntegration.
createDataIntegrationResponse_kmsKey :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_kmsKey :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:kmsKey:CreateDataIntegrationResponse' :: Maybe Text
kmsKey = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | The name of the DataIntegration.
createDataIntegrationResponse_name :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_name :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:name:CreateDataIntegrationResponse' :: Maybe Text
name = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | The name of the data and how often it should be pulled from the source.
createDataIntegrationResponse_scheduleConfiguration :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe ScheduleConfiguration)
createDataIntegrationResponse_scheduleConfiguration :: Lens' CreateDataIntegrationResponse (Maybe ScheduleConfiguration)
createDataIntegrationResponse_scheduleConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe ScheduleConfiguration
scheduleConfiguration :: Maybe ScheduleConfiguration
$sel:scheduleConfiguration:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe ScheduleConfiguration
scheduleConfiguration} -> Maybe ScheduleConfiguration
scheduleConfiguration) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe ScheduleConfiguration
a -> CreateDataIntegrationResponse
s {$sel:scheduleConfiguration:CreateDataIntegrationResponse' :: Maybe ScheduleConfiguration
scheduleConfiguration = Maybe ScheduleConfiguration
a} :: CreateDataIntegrationResponse)

-- | The URI of the data source.
createDataIntegrationResponse_sourceURI :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe Prelude.Text)
createDataIntegrationResponse_sourceURI :: Lens' CreateDataIntegrationResponse (Maybe Text)
createDataIntegrationResponse_sourceURI = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe Text
sourceURI :: Maybe Text
$sel:sourceURI:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
sourceURI} -> Maybe Text
sourceURI) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe Text
a -> CreateDataIntegrationResponse
s {$sel:sourceURI:CreateDataIntegrationResponse' :: Maybe Text
sourceURI = Maybe Text
a} :: CreateDataIntegrationResponse)

-- | One or more tags.
createDataIntegrationResponse_tags :: Lens.Lens' CreateDataIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDataIntegrationResponse_tags :: Lens' CreateDataIntegrationResponse (Maybe (HashMap Text Text))
createDataIntegrationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Maybe (HashMap Text Text)
a -> CreateDataIntegrationResponse
s {$sel:tags:CreateDataIntegrationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateDataIntegrationResponse) 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 response's http status code.
createDataIntegrationResponse_httpStatus :: Lens.Lens' CreateDataIntegrationResponse Prelude.Int
createDataIntegrationResponse_httpStatus :: Lens' CreateDataIntegrationResponse Int
createDataIntegrationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataIntegrationResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateDataIntegrationResponse
s@CreateDataIntegrationResponse' {} Int
a -> CreateDataIntegrationResponse
s {$sel:httpStatus:CreateDataIntegrationResponse' :: Int
httpStatus = Int
a} :: CreateDataIntegrationResponse)

instance Prelude.NFData CreateDataIntegrationResponse where
  rnf :: CreateDataIntegrationResponse -> ()
rnf CreateDataIntegrationResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduleConfiguration
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
sourceURI :: Maybe Text
scheduleConfiguration :: Maybe ScheduleConfiguration
name :: Maybe Text
kmsKey :: Maybe Text
id :: Maybe Text
description :: Maybe Text
clientToken :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Int
$sel:tags:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe (HashMap Text Text)
$sel:sourceURI:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:scheduleConfiguration:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe ScheduleConfiguration
$sel:name:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:kmsKey:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:id:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:description:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:clientToken:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
$sel:arn:CreateDataIntegrationResponse' :: CreateDataIntegrationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ScheduleConfiguration
scheduleConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceURI
      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 Int
httpStatus