{-# 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.KinesisAnalytics.AddApplicationReferenceDataSource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This documentation is for version 1 of the Amazon Kinesis Data Analytics
-- API, which only supports SQL applications. Version 2 of the API supports
-- SQL and Java applications. For more information about version 2, see
-- </kinesisanalytics/latest/apiv2/Welcome.html Amazon Kinesis Data Analytics API V2 Documentation>.
--
-- Adds a reference data source to an existing application.
--
-- Amazon Kinesis Analytics reads reference data (that is, an Amazon S3
-- object) and creates an in-application table within your application. In
-- the request, you provide the source (S3 bucket name and object key
-- name), name of the in-application table to create, and the necessary
-- mapping information that describes how data in Amazon S3 object maps to
-- columns in the resulting in-application table.
--
-- For conceptual information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-input.html Configuring Application Input>.
-- For the limits on data sources you can add to your application, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/limits.html Limits>.
--
-- This operation requires permissions to perform the
-- @kinesisanalytics:AddApplicationOutput@ action.
module Amazonka.KinesisAnalytics.AddApplicationReferenceDataSource
  ( -- * Creating a Request
    AddApplicationReferenceDataSource (..),
    newAddApplicationReferenceDataSource,

    -- * Request Lenses
    addApplicationReferenceDataSource_applicationName,
    addApplicationReferenceDataSource_currentApplicationVersionId,
    addApplicationReferenceDataSource_referenceDataSource,

    -- * Destructuring the Response
    AddApplicationReferenceDataSourceResponse (..),
    newAddApplicationReferenceDataSourceResponse,

    -- * Response Lenses
    addApplicationReferenceDataSourceResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KinesisAnalytics.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newAddApplicationReferenceDataSource' smart constructor.
data AddApplicationReferenceDataSource = AddApplicationReferenceDataSource'
  { -- | Name of an existing application.
    AddApplicationReferenceDataSource -> Text
applicationName :: Prelude.Text,
    -- | Version of the application for which you are adding the reference data
    -- source. You can use the
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
    -- operation to get the current application version. If the version
    -- specified is not the current version, the
    -- @ConcurrentModificationException@ is returned.
    AddApplicationReferenceDataSource -> Natural
currentApplicationVersionId :: Prelude.Natural,
    -- | The reference data source can be an object in your Amazon S3 bucket.
    -- Amazon Kinesis Analytics reads the object and copies the data into the
    -- in-application table that is created. You provide an S3 bucket, object
    -- key name, and the resulting in-application table that is created. You
    -- must also provide an IAM role with the necessary permissions that Amazon
    -- Kinesis Analytics can assume to read the object from your S3 bucket on
    -- your behalf.
    AddApplicationReferenceDataSource -> ReferenceDataSource
referenceDataSource :: ReferenceDataSource
  }
  deriving (AddApplicationReferenceDataSource
-> AddApplicationReferenceDataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddApplicationReferenceDataSource
-> AddApplicationReferenceDataSource -> Bool
$c/= :: AddApplicationReferenceDataSource
-> AddApplicationReferenceDataSource -> Bool
== :: AddApplicationReferenceDataSource
-> AddApplicationReferenceDataSource -> Bool
$c== :: AddApplicationReferenceDataSource
-> AddApplicationReferenceDataSource -> Bool
Prelude.Eq, ReadPrec [AddApplicationReferenceDataSource]
ReadPrec AddApplicationReferenceDataSource
Int -> ReadS AddApplicationReferenceDataSource
ReadS [AddApplicationReferenceDataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddApplicationReferenceDataSource]
$creadListPrec :: ReadPrec [AddApplicationReferenceDataSource]
readPrec :: ReadPrec AddApplicationReferenceDataSource
$creadPrec :: ReadPrec AddApplicationReferenceDataSource
readList :: ReadS [AddApplicationReferenceDataSource]
$creadList :: ReadS [AddApplicationReferenceDataSource]
readsPrec :: Int -> ReadS AddApplicationReferenceDataSource
$creadsPrec :: Int -> ReadS AddApplicationReferenceDataSource
Prelude.Read, Int -> AddApplicationReferenceDataSource -> ShowS
[AddApplicationReferenceDataSource] -> ShowS
AddApplicationReferenceDataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddApplicationReferenceDataSource] -> ShowS
$cshowList :: [AddApplicationReferenceDataSource] -> ShowS
show :: AddApplicationReferenceDataSource -> String
$cshow :: AddApplicationReferenceDataSource -> String
showsPrec :: Int -> AddApplicationReferenceDataSource -> ShowS
$cshowsPrec :: Int -> AddApplicationReferenceDataSource -> ShowS
Prelude.Show, forall x.
Rep AddApplicationReferenceDataSource x
-> AddApplicationReferenceDataSource
forall x.
AddApplicationReferenceDataSource
-> Rep AddApplicationReferenceDataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddApplicationReferenceDataSource x
-> AddApplicationReferenceDataSource
$cfrom :: forall x.
AddApplicationReferenceDataSource
-> Rep AddApplicationReferenceDataSource x
Prelude.Generic)

-- |
-- Create a value of 'AddApplicationReferenceDataSource' 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:
--
-- 'applicationName', 'addApplicationReferenceDataSource_applicationName' - Name of an existing application.
--
-- 'currentApplicationVersionId', 'addApplicationReferenceDataSource_currentApplicationVersionId' - Version of the application for which you are adding the reference data
-- source. You can use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to get the current application version. If the version
-- specified is not the current version, the
-- @ConcurrentModificationException@ is returned.
--
-- 'referenceDataSource', 'addApplicationReferenceDataSource_referenceDataSource' - The reference data source can be an object in your Amazon S3 bucket.
-- Amazon Kinesis Analytics reads the object and copies the data into the
-- in-application table that is created. You provide an S3 bucket, object
-- key name, and the resulting in-application table that is created. You
-- must also provide an IAM role with the necessary permissions that Amazon
-- Kinesis Analytics can assume to read the object from your S3 bucket on
-- your behalf.
newAddApplicationReferenceDataSource ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'currentApplicationVersionId'
  Prelude.Natural ->
  -- | 'referenceDataSource'
  ReferenceDataSource ->
  AddApplicationReferenceDataSource
newAddApplicationReferenceDataSource :: Text
-> Natural
-> ReferenceDataSource
-> AddApplicationReferenceDataSource
newAddApplicationReferenceDataSource
  Text
pApplicationName_
  Natural
pCurrentApplicationVersionId_
  ReferenceDataSource
pReferenceDataSource_ =
    AddApplicationReferenceDataSource'
      { $sel:applicationName:AddApplicationReferenceDataSource' :: Text
applicationName =
          Text
pApplicationName_,
        $sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: Natural
currentApplicationVersionId =
          Natural
pCurrentApplicationVersionId_,
        $sel:referenceDataSource:AddApplicationReferenceDataSource' :: ReferenceDataSource
referenceDataSource =
          ReferenceDataSource
pReferenceDataSource_
      }

-- | Name of an existing application.
addApplicationReferenceDataSource_applicationName :: Lens.Lens' AddApplicationReferenceDataSource Prelude.Text
addApplicationReferenceDataSource_applicationName :: Lens' AddApplicationReferenceDataSource Text
addApplicationReferenceDataSource_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationReferenceDataSource' {Text
applicationName :: Text
$sel:applicationName:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Text
applicationName} -> Text
applicationName) (\s :: AddApplicationReferenceDataSource
s@AddApplicationReferenceDataSource' {} Text
a -> AddApplicationReferenceDataSource
s {$sel:applicationName:AddApplicationReferenceDataSource' :: Text
applicationName = Text
a} :: AddApplicationReferenceDataSource)

-- | Version of the application for which you are adding the reference data
-- source. You can use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to get the current application version. If the version
-- specified is not the current version, the
-- @ConcurrentModificationException@ is returned.
addApplicationReferenceDataSource_currentApplicationVersionId :: Lens.Lens' AddApplicationReferenceDataSource Prelude.Natural
addApplicationReferenceDataSource_currentApplicationVersionId :: Lens' AddApplicationReferenceDataSource Natural
addApplicationReferenceDataSource_currentApplicationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationReferenceDataSource' {Natural
currentApplicationVersionId :: Natural
$sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Natural
currentApplicationVersionId} -> Natural
currentApplicationVersionId) (\s :: AddApplicationReferenceDataSource
s@AddApplicationReferenceDataSource' {} Natural
a -> AddApplicationReferenceDataSource
s {$sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: Natural
currentApplicationVersionId = Natural
a} :: AddApplicationReferenceDataSource)

-- | The reference data source can be an object in your Amazon S3 bucket.
-- Amazon Kinesis Analytics reads the object and copies the data into the
-- in-application table that is created. You provide an S3 bucket, object
-- key name, and the resulting in-application table that is created. You
-- must also provide an IAM role with the necessary permissions that Amazon
-- Kinesis Analytics can assume to read the object from your S3 bucket on
-- your behalf.
addApplicationReferenceDataSource_referenceDataSource :: Lens.Lens' AddApplicationReferenceDataSource ReferenceDataSource
addApplicationReferenceDataSource_referenceDataSource :: Lens' AddApplicationReferenceDataSource ReferenceDataSource
addApplicationReferenceDataSource_referenceDataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationReferenceDataSource' {ReferenceDataSource
referenceDataSource :: ReferenceDataSource
$sel:referenceDataSource:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> ReferenceDataSource
referenceDataSource} -> ReferenceDataSource
referenceDataSource) (\s :: AddApplicationReferenceDataSource
s@AddApplicationReferenceDataSource' {} ReferenceDataSource
a -> AddApplicationReferenceDataSource
s {$sel:referenceDataSource:AddApplicationReferenceDataSource' :: ReferenceDataSource
referenceDataSource = ReferenceDataSource
a} :: AddApplicationReferenceDataSource)

instance
  Core.AWSRequest
    AddApplicationReferenceDataSource
  where
  type
    AWSResponse AddApplicationReferenceDataSource =
      AddApplicationReferenceDataSourceResponse
  request :: (Service -> Service)
-> AddApplicationReferenceDataSource
-> Request AddApplicationReferenceDataSource
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 AddApplicationReferenceDataSource
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AddApplicationReferenceDataSource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AddApplicationReferenceDataSourceResponse
AddApplicationReferenceDataSourceResponse'
            forall (f :: * -> *) a b. Functor 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
    AddApplicationReferenceDataSource
  where
  hashWithSalt :: Int -> AddApplicationReferenceDataSource -> Int
hashWithSalt
    Int
_salt
    AddApplicationReferenceDataSource' {Natural
Text
ReferenceDataSource
referenceDataSource :: ReferenceDataSource
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:referenceDataSource:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> ReferenceDataSource
$sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Natural
$sel:applicationName:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
currentApplicationVersionId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReferenceDataSource
referenceDataSource

instance
  Prelude.NFData
    AddApplicationReferenceDataSource
  where
  rnf :: AddApplicationReferenceDataSource -> ()
rnf AddApplicationReferenceDataSource' {Natural
Text
ReferenceDataSource
referenceDataSource :: ReferenceDataSource
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:referenceDataSource:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> ReferenceDataSource
$sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Natural
$sel:applicationName:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
currentApplicationVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReferenceDataSource
referenceDataSource

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

instance
  Data.ToJSON
    AddApplicationReferenceDataSource
  where
  toJSON :: AddApplicationReferenceDataSource -> Value
toJSON AddApplicationReferenceDataSource' {Natural
Text
ReferenceDataSource
referenceDataSource :: ReferenceDataSource
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:referenceDataSource:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> ReferenceDataSource
$sel:currentApplicationVersionId:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Natural
$sel:applicationName:AddApplicationReferenceDataSource' :: AddApplicationReferenceDataSource -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ApplicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CurrentApplicationVersionId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
currentApplicationVersionId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReferenceDataSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReferenceDataSource
referenceDataSource)
          ]
      )

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

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

-- |
--
-- /See:/ 'newAddApplicationReferenceDataSourceResponse' smart constructor.
data AddApplicationReferenceDataSourceResponse = AddApplicationReferenceDataSourceResponse'
  { -- | The response's http status code.
    AddApplicationReferenceDataSourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddApplicationReferenceDataSourceResponse
-> AddApplicationReferenceDataSourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddApplicationReferenceDataSourceResponse
-> AddApplicationReferenceDataSourceResponse -> Bool
$c/= :: AddApplicationReferenceDataSourceResponse
-> AddApplicationReferenceDataSourceResponse -> Bool
== :: AddApplicationReferenceDataSourceResponse
-> AddApplicationReferenceDataSourceResponse -> Bool
$c== :: AddApplicationReferenceDataSourceResponse
-> AddApplicationReferenceDataSourceResponse -> Bool
Prelude.Eq, ReadPrec [AddApplicationReferenceDataSourceResponse]
ReadPrec AddApplicationReferenceDataSourceResponse
Int -> ReadS AddApplicationReferenceDataSourceResponse
ReadS [AddApplicationReferenceDataSourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddApplicationReferenceDataSourceResponse]
$creadListPrec :: ReadPrec [AddApplicationReferenceDataSourceResponse]
readPrec :: ReadPrec AddApplicationReferenceDataSourceResponse
$creadPrec :: ReadPrec AddApplicationReferenceDataSourceResponse
readList :: ReadS [AddApplicationReferenceDataSourceResponse]
$creadList :: ReadS [AddApplicationReferenceDataSourceResponse]
readsPrec :: Int -> ReadS AddApplicationReferenceDataSourceResponse
$creadsPrec :: Int -> ReadS AddApplicationReferenceDataSourceResponse
Prelude.Read, Int -> AddApplicationReferenceDataSourceResponse -> ShowS
[AddApplicationReferenceDataSourceResponse] -> ShowS
AddApplicationReferenceDataSourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddApplicationReferenceDataSourceResponse] -> ShowS
$cshowList :: [AddApplicationReferenceDataSourceResponse] -> ShowS
show :: AddApplicationReferenceDataSourceResponse -> String
$cshow :: AddApplicationReferenceDataSourceResponse -> String
showsPrec :: Int -> AddApplicationReferenceDataSourceResponse -> ShowS
$cshowsPrec :: Int -> AddApplicationReferenceDataSourceResponse -> ShowS
Prelude.Show, forall x.
Rep AddApplicationReferenceDataSourceResponse x
-> AddApplicationReferenceDataSourceResponse
forall x.
AddApplicationReferenceDataSourceResponse
-> Rep AddApplicationReferenceDataSourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddApplicationReferenceDataSourceResponse x
-> AddApplicationReferenceDataSourceResponse
$cfrom :: forall x.
AddApplicationReferenceDataSourceResponse
-> Rep AddApplicationReferenceDataSourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddApplicationReferenceDataSourceResponse' 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:
--
-- 'httpStatus', 'addApplicationReferenceDataSourceResponse_httpStatus' - The response's http status code.
newAddApplicationReferenceDataSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddApplicationReferenceDataSourceResponse
newAddApplicationReferenceDataSourceResponse :: Int -> AddApplicationReferenceDataSourceResponse
newAddApplicationReferenceDataSourceResponse
  Int
pHttpStatus_ =
    AddApplicationReferenceDataSourceResponse'
      { $sel:httpStatus:AddApplicationReferenceDataSourceResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    AddApplicationReferenceDataSourceResponse
  where
  rnf :: AddApplicationReferenceDataSourceResponse -> ()
rnf AddApplicationReferenceDataSourceResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddApplicationReferenceDataSourceResponse' :: AddApplicationReferenceDataSourceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus