{-# 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.MarketplaceAnalytics.StartSupportDataExport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Given a data set type and a from date, asynchronously publishes the
-- requested customer support data to the specified S3 bucket and notifies
-- the specified SNS topic once the data is available. Returns a unique
-- request identifier that can be used to correlate requests with
-- notifications from the SNS topic. Data sets will be published in
-- comma-separated values (CSV) format with the file name
-- {data_set_type}_YYYY-MM-DD\'T\'HH-mm-ss\'Z\'.csv. If a file with the
-- same name already exists (e.g. if the same data set is requested twice),
-- the original file will be overwritten by the new file. Requires a Role
-- with an attached permissions policy providing Allow permissions for the
-- following actions: s3:PutObject, s3:GetBucketLocation,
-- sns:GetTopicAttributes, sns:Publish, iam:GetRolePolicy.
module Amazonka.MarketplaceAnalytics.StartSupportDataExport
  ( -- * Creating a Request
    StartSupportDataExport (..),
    newStartSupportDataExport,

    -- * Request Lenses
    startSupportDataExport_customerDefinedValues,
    startSupportDataExport_destinationS3Prefix,
    startSupportDataExport_dataSetType,
    startSupportDataExport_fromDate,
    startSupportDataExport_roleNameArn,
    startSupportDataExport_destinationS3BucketName,
    startSupportDataExport_snsTopicArn,

    -- * Destructuring the Response
    StartSupportDataExportResponse (..),
    newStartSupportDataExportResponse,

    -- * Response Lenses
    startSupportDataExportResponse_dataSetRequestId,
    startSupportDataExportResponse_httpStatus,
  )
where

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

-- | Container for the parameters to the StartSupportDataExport operation.
--
-- /See:/ 'newStartSupportDataExport' smart constructor.
data StartSupportDataExport = StartSupportDataExport'
  { -- | (Optional) Key-value pairs which will be returned, unmodified, in the
    -- Amazon SNS notification message and the data set metadata file.
    StartSupportDataExport -> Maybe (HashMap Text Text)
customerDefinedValues :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | (Optional) The desired S3 prefix for the published data set, similar to
    -- a directory path in standard file systems. For example, if given the
    -- bucket name \"mybucket\" and the prefix \"myprefix\/mydatasets\", the
    -- output file \"outputfile\" would be published to
    -- \"s3:\/\/mybucket\/myprefix\/mydatasets\/outputfile\". If the prefix
    -- directory structure does not exist, it will be created. If no prefix is
    -- provided, the data set will be published to the S3 bucket root.
    StartSupportDataExport -> Maybe Text
destinationS3Prefix :: Prelude.Maybe Prelude.Text,
    -- | Specifies the data set type to be written to the output csv file. The
    -- data set types customer_support_contacts_data and
    -- test_customer_support_contacts_data both result in a csv file containing
    -- the following fields: Product Id, Product Code, Customer Guid,
    -- Subscription Guid, Subscription Start Date, Organization, AWS Account
    -- Id, Given Name, Surname, Telephone Number, Email, Title, Country Code,
    -- ZIP Code, Operation Type, and Operation Time.
    --
    -- -   /customer_support_contacts_data/ Customer support contact data. The
    --     data set will contain all changes (Creates, Updates, and Deletes) to
    --     customer support contact data from the date specified in the
    --     from_date parameter.
    -- -   /test_customer_support_contacts_data/ An example data set containing
    --     static test data in the same format as
    --     customer_support_contacts_data
    StartSupportDataExport -> SupportDataSetType
dataSetType :: SupportDataSetType,
    -- | The start date from which to retrieve the data set in UTC. This
    -- parameter only affects the customer_support_contacts_data data set type.
    StartSupportDataExport -> POSIX
fromDate :: Data.POSIX,
    -- | The Amazon Resource Name (ARN) of the Role with an attached permissions
    -- policy to interact with the provided AWS services.
    StartSupportDataExport -> Text
roleNameArn :: Prelude.Text,
    -- | The name (friendly name, not ARN) of the destination S3 bucket.
    StartSupportDataExport -> Text
destinationS3BucketName :: Prelude.Text,
    -- | Amazon Resource Name (ARN) for the SNS Topic that will be notified when
    -- the data set has been published or if an error has occurred.
    StartSupportDataExport -> Text
snsTopicArn :: Prelude.Text
  }
  deriving (StartSupportDataExport -> StartSupportDataExport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSupportDataExport -> StartSupportDataExport -> Bool
$c/= :: StartSupportDataExport -> StartSupportDataExport -> Bool
== :: StartSupportDataExport -> StartSupportDataExport -> Bool
$c== :: StartSupportDataExport -> StartSupportDataExport -> Bool
Prelude.Eq, ReadPrec [StartSupportDataExport]
ReadPrec StartSupportDataExport
Int -> ReadS StartSupportDataExport
ReadS [StartSupportDataExport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSupportDataExport]
$creadListPrec :: ReadPrec [StartSupportDataExport]
readPrec :: ReadPrec StartSupportDataExport
$creadPrec :: ReadPrec StartSupportDataExport
readList :: ReadS [StartSupportDataExport]
$creadList :: ReadS [StartSupportDataExport]
readsPrec :: Int -> ReadS StartSupportDataExport
$creadsPrec :: Int -> ReadS StartSupportDataExport
Prelude.Read, Int -> StartSupportDataExport -> ShowS
[StartSupportDataExport] -> ShowS
StartSupportDataExport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSupportDataExport] -> ShowS
$cshowList :: [StartSupportDataExport] -> ShowS
show :: StartSupportDataExport -> String
$cshow :: StartSupportDataExport -> String
showsPrec :: Int -> StartSupportDataExport -> ShowS
$cshowsPrec :: Int -> StartSupportDataExport -> ShowS
Prelude.Show, forall x. Rep StartSupportDataExport x -> StartSupportDataExport
forall x. StartSupportDataExport -> Rep StartSupportDataExport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSupportDataExport x -> StartSupportDataExport
$cfrom :: forall x. StartSupportDataExport -> Rep StartSupportDataExport x
Prelude.Generic)

-- |
-- Create a value of 'StartSupportDataExport' 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:
--
-- 'customerDefinedValues', 'startSupportDataExport_customerDefinedValues' - (Optional) Key-value pairs which will be returned, unmodified, in the
-- Amazon SNS notification message and the data set metadata file.
--
-- 'destinationS3Prefix', 'startSupportDataExport_destinationS3Prefix' - (Optional) The desired S3 prefix for the published data set, similar to
-- a directory path in standard file systems. For example, if given the
-- bucket name \"mybucket\" and the prefix \"myprefix\/mydatasets\", the
-- output file \"outputfile\" would be published to
-- \"s3:\/\/mybucket\/myprefix\/mydatasets\/outputfile\". If the prefix
-- directory structure does not exist, it will be created. If no prefix is
-- provided, the data set will be published to the S3 bucket root.
--
-- 'dataSetType', 'startSupportDataExport_dataSetType' - Specifies the data set type to be written to the output csv file. The
-- data set types customer_support_contacts_data and
-- test_customer_support_contacts_data both result in a csv file containing
-- the following fields: Product Id, Product Code, Customer Guid,
-- Subscription Guid, Subscription Start Date, Organization, AWS Account
-- Id, Given Name, Surname, Telephone Number, Email, Title, Country Code,
-- ZIP Code, Operation Type, and Operation Time.
--
-- -   /customer_support_contacts_data/ Customer support contact data. The
--     data set will contain all changes (Creates, Updates, and Deletes) to
--     customer support contact data from the date specified in the
--     from_date parameter.
-- -   /test_customer_support_contacts_data/ An example data set containing
--     static test data in the same format as
--     customer_support_contacts_data
--
-- 'fromDate', 'startSupportDataExport_fromDate' - The start date from which to retrieve the data set in UTC. This
-- parameter only affects the customer_support_contacts_data data set type.
--
-- 'roleNameArn', 'startSupportDataExport_roleNameArn' - The Amazon Resource Name (ARN) of the Role with an attached permissions
-- policy to interact with the provided AWS services.
--
-- 'destinationS3BucketName', 'startSupportDataExport_destinationS3BucketName' - The name (friendly name, not ARN) of the destination S3 bucket.
--
-- 'snsTopicArn', 'startSupportDataExport_snsTopicArn' - Amazon Resource Name (ARN) for the SNS Topic that will be notified when
-- the data set has been published or if an error has occurred.
newStartSupportDataExport ::
  -- | 'dataSetType'
  SupportDataSetType ->
  -- | 'fromDate'
  Prelude.UTCTime ->
  -- | 'roleNameArn'
  Prelude.Text ->
  -- | 'destinationS3BucketName'
  Prelude.Text ->
  -- | 'snsTopicArn'
  Prelude.Text ->
  StartSupportDataExport
newStartSupportDataExport :: SupportDataSetType
-> UTCTime -> Text -> Text -> Text -> StartSupportDataExport
newStartSupportDataExport
  SupportDataSetType
pDataSetType_
  UTCTime
pFromDate_
  Text
pRoleNameArn_
  Text
pDestinationS3BucketName_
  Text
pSnsTopicArn_ =
    StartSupportDataExport'
      { $sel:customerDefinedValues:StartSupportDataExport' :: Maybe (HashMap Text Text)
customerDefinedValues =
          forall a. Maybe a
Prelude.Nothing,
        $sel:destinationS3Prefix:StartSupportDataExport' :: Maybe Text
destinationS3Prefix = forall a. Maybe a
Prelude.Nothing,
        $sel:dataSetType:StartSupportDataExport' :: SupportDataSetType
dataSetType = SupportDataSetType
pDataSetType_,
        $sel:fromDate:StartSupportDataExport' :: POSIX
fromDate = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pFromDate_,
        $sel:roleNameArn:StartSupportDataExport' :: Text
roleNameArn = Text
pRoleNameArn_,
        $sel:destinationS3BucketName:StartSupportDataExport' :: Text
destinationS3BucketName = Text
pDestinationS3BucketName_,
        $sel:snsTopicArn:StartSupportDataExport' :: Text
snsTopicArn = Text
pSnsTopicArn_
      }

-- | (Optional) Key-value pairs which will be returned, unmodified, in the
-- Amazon SNS notification message and the data set metadata file.
startSupportDataExport_customerDefinedValues :: Lens.Lens' StartSupportDataExport (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startSupportDataExport_customerDefinedValues :: Lens' StartSupportDataExport (Maybe (HashMap Text Text))
startSupportDataExport_customerDefinedValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {Maybe (HashMap Text Text)
customerDefinedValues :: Maybe (HashMap Text Text)
$sel:customerDefinedValues:StartSupportDataExport' :: StartSupportDataExport -> Maybe (HashMap Text Text)
customerDefinedValues} -> Maybe (HashMap Text Text)
customerDefinedValues) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} Maybe (HashMap Text Text)
a -> StartSupportDataExport
s {$sel:customerDefinedValues:StartSupportDataExport' :: Maybe (HashMap Text Text)
customerDefinedValues = Maybe (HashMap Text Text)
a} :: StartSupportDataExport) 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

-- | (Optional) The desired S3 prefix for the published data set, similar to
-- a directory path in standard file systems. For example, if given the
-- bucket name \"mybucket\" and the prefix \"myprefix\/mydatasets\", the
-- output file \"outputfile\" would be published to
-- \"s3:\/\/mybucket\/myprefix\/mydatasets\/outputfile\". If the prefix
-- directory structure does not exist, it will be created. If no prefix is
-- provided, the data set will be published to the S3 bucket root.
startSupportDataExport_destinationS3Prefix :: Lens.Lens' StartSupportDataExport (Prelude.Maybe Prelude.Text)
startSupportDataExport_destinationS3Prefix :: Lens' StartSupportDataExport (Maybe Text)
startSupportDataExport_destinationS3Prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {Maybe Text
destinationS3Prefix :: Maybe Text
$sel:destinationS3Prefix:StartSupportDataExport' :: StartSupportDataExport -> Maybe Text
destinationS3Prefix} -> Maybe Text
destinationS3Prefix) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} Maybe Text
a -> StartSupportDataExport
s {$sel:destinationS3Prefix:StartSupportDataExport' :: Maybe Text
destinationS3Prefix = Maybe Text
a} :: StartSupportDataExport)

-- | Specifies the data set type to be written to the output csv file. The
-- data set types customer_support_contacts_data and
-- test_customer_support_contacts_data both result in a csv file containing
-- the following fields: Product Id, Product Code, Customer Guid,
-- Subscription Guid, Subscription Start Date, Organization, AWS Account
-- Id, Given Name, Surname, Telephone Number, Email, Title, Country Code,
-- ZIP Code, Operation Type, and Operation Time.
--
-- -   /customer_support_contacts_data/ Customer support contact data. The
--     data set will contain all changes (Creates, Updates, and Deletes) to
--     customer support contact data from the date specified in the
--     from_date parameter.
-- -   /test_customer_support_contacts_data/ An example data set containing
--     static test data in the same format as
--     customer_support_contacts_data
startSupportDataExport_dataSetType :: Lens.Lens' StartSupportDataExport SupportDataSetType
startSupportDataExport_dataSetType :: Lens' StartSupportDataExport SupportDataSetType
startSupportDataExport_dataSetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {SupportDataSetType
dataSetType :: SupportDataSetType
$sel:dataSetType:StartSupportDataExport' :: StartSupportDataExport -> SupportDataSetType
dataSetType} -> SupportDataSetType
dataSetType) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} SupportDataSetType
a -> StartSupportDataExport
s {$sel:dataSetType:StartSupportDataExport' :: SupportDataSetType
dataSetType = SupportDataSetType
a} :: StartSupportDataExport)

-- | The start date from which to retrieve the data set in UTC. This
-- parameter only affects the customer_support_contacts_data data set type.
startSupportDataExport_fromDate :: Lens.Lens' StartSupportDataExport Prelude.UTCTime
startSupportDataExport_fromDate :: Lens' StartSupportDataExport UTCTime
startSupportDataExport_fromDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {POSIX
fromDate :: POSIX
$sel:fromDate:StartSupportDataExport' :: StartSupportDataExport -> POSIX
fromDate} -> POSIX
fromDate) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} POSIX
a -> StartSupportDataExport
s {$sel:fromDate:StartSupportDataExport' :: POSIX
fromDate = POSIX
a} :: StartSupportDataExport) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) of the Role with an attached permissions
-- policy to interact with the provided AWS services.
startSupportDataExport_roleNameArn :: Lens.Lens' StartSupportDataExport Prelude.Text
startSupportDataExport_roleNameArn :: Lens' StartSupportDataExport Text
startSupportDataExport_roleNameArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {Text
roleNameArn :: Text
$sel:roleNameArn:StartSupportDataExport' :: StartSupportDataExport -> Text
roleNameArn} -> Text
roleNameArn) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} Text
a -> StartSupportDataExport
s {$sel:roleNameArn:StartSupportDataExport' :: Text
roleNameArn = Text
a} :: StartSupportDataExport)

-- | The name (friendly name, not ARN) of the destination S3 bucket.
startSupportDataExport_destinationS3BucketName :: Lens.Lens' StartSupportDataExport Prelude.Text
startSupportDataExport_destinationS3BucketName :: Lens' StartSupportDataExport Text
startSupportDataExport_destinationS3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {Text
destinationS3BucketName :: Text
$sel:destinationS3BucketName:StartSupportDataExport' :: StartSupportDataExport -> Text
destinationS3BucketName} -> Text
destinationS3BucketName) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} Text
a -> StartSupportDataExport
s {$sel:destinationS3BucketName:StartSupportDataExport' :: Text
destinationS3BucketName = Text
a} :: StartSupportDataExport)

-- | Amazon Resource Name (ARN) for the SNS Topic that will be notified when
-- the data set has been published or if an error has occurred.
startSupportDataExport_snsTopicArn :: Lens.Lens' StartSupportDataExport Prelude.Text
startSupportDataExport_snsTopicArn :: Lens' StartSupportDataExport Text
startSupportDataExport_snsTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExport' {Text
snsTopicArn :: Text
$sel:snsTopicArn:StartSupportDataExport' :: StartSupportDataExport -> Text
snsTopicArn} -> Text
snsTopicArn) (\s :: StartSupportDataExport
s@StartSupportDataExport' {} Text
a -> StartSupportDataExport
s {$sel:snsTopicArn:StartSupportDataExport' :: Text
snsTopicArn = Text
a} :: StartSupportDataExport)

instance Core.AWSRequest StartSupportDataExport where
  type
    AWSResponse StartSupportDataExport =
      StartSupportDataExportResponse
  request :: (Service -> Service)
-> StartSupportDataExport -> Request StartSupportDataExport
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 StartSupportDataExport
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartSupportDataExport)))
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 -> Int -> StartSupportDataExportResponse
StartSupportDataExportResponse'
            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
"dataSetRequestId")
            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 StartSupportDataExport where
  hashWithSalt :: Int -> StartSupportDataExport -> Int
hashWithSalt Int
_salt StartSupportDataExport' {Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
SupportDataSetType
snsTopicArn :: Text
destinationS3BucketName :: Text
roleNameArn :: Text
fromDate :: POSIX
dataSetType :: SupportDataSetType
destinationS3Prefix :: Maybe Text
customerDefinedValues :: Maybe (HashMap Text Text)
$sel:snsTopicArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:destinationS3BucketName:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:roleNameArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:fromDate:StartSupportDataExport' :: StartSupportDataExport -> POSIX
$sel:dataSetType:StartSupportDataExport' :: StartSupportDataExport -> SupportDataSetType
$sel:destinationS3Prefix:StartSupportDataExport' :: StartSupportDataExport -> Maybe Text
$sel:customerDefinedValues:StartSupportDataExport' :: StartSupportDataExport -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
customerDefinedValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationS3Prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SupportDataSetType
dataSetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
fromDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleNameArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationS3BucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snsTopicArn

instance Prelude.NFData StartSupportDataExport where
  rnf :: StartSupportDataExport -> ()
rnf StartSupportDataExport' {Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
SupportDataSetType
snsTopicArn :: Text
destinationS3BucketName :: Text
roleNameArn :: Text
fromDate :: POSIX
dataSetType :: SupportDataSetType
destinationS3Prefix :: Maybe Text
customerDefinedValues :: Maybe (HashMap Text Text)
$sel:snsTopicArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:destinationS3BucketName:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:roleNameArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:fromDate:StartSupportDataExport' :: StartSupportDataExport -> POSIX
$sel:dataSetType:StartSupportDataExport' :: StartSupportDataExport -> SupportDataSetType
$sel:destinationS3Prefix:StartSupportDataExport' :: StartSupportDataExport -> Maybe Text
$sel:customerDefinedValues:StartSupportDataExport' :: StartSupportDataExport -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
customerDefinedValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationS3Prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SupportDataSetType
dataSetType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
fromDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleNameArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationS3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snsTopicArn

instance Data.ToHeaders StartSupportDataExport where
  toHeaders :: StartSupportDataExport -> 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
"MarketplaceCommerceAnalytics20150701.StartSupportDataExport" ::
                          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 StartSupportDataExport where
  toJSON :: StartSupportDataExport -> Value
toJSON StartSupportDataExport' {Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
SupportDataSetType
snsTopicArn :: Text
destinationS3BucketName :: Text
roleNameArn :: Text
fromDate :: POSIX
dataSetType :: SupportDataSetType
destinationS3Prefix :: Maybe Text
customerDefinedValues :: Maybe (HashMap Text Text)
$sel:snsTopicArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:destinationS3BucketName:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:roleNameArn:StartSupportDataExport' :: StartSupportDataExport -> Text
$sel:fromDate:StartSupportDataExport' :: StartSupportDataExport -> POSIX
$sel:dataSetType:StartSupportDataExport' :: StartSupportDataExport -> SupportDataSetType
$sel:destinationS3Prefix:StartSupportDataExport' :: StartSupportDataExport -> Maybe Text
$sel:customerDefinedValues:StartSupportDataExport' :: StartSupportDataExport -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"customerDefinedValues" 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)
customerDefinedValues,
            (Key
"destinationS3Prefix" 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
destinationS3Prefix,
            forall a. a -> Maybe a
Prelude.Just (Key
"dataSetType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SupportDataSetType
dataSetType),
            forall a. a -> Maybe a
Prelude.Just (Key
"fromDate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
fromDate),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleNameArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleNameArn),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"destinationS3BucketName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationS3BucketName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"snsTopicArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
snsTopicArn)
          ]
      )

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

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

-- | Container for the result of the StartSupportDataExport operation.
--
-- /See:/ 'newStartSupportDataExportResponse' smart constructor.
data StartSupportDataExportResponse = StartSupportDataExportResponse'
  { -- | A unique identifier representing a specific request to the
    -- StartSupportDataExport operation. This identifier can be used to
    -- correlate a request with notifications from the SNS topic.
    StartSupportDataExportResponse -> Maybe Text
dataSetRequestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartSupportDataExportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSupportDataExportResponse
-> StartSupportDataExportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSupportDataExportResponse
-> StartSupportDataExportResponse -> Bool
$c/= :: StartSupportDataExportResponse
-> StartSupportDataExportResponse -> Bool
== :: StartSupportDataExportResponse
-> StartSupportDataExportResponse -> Bool
$c== :: StartSupportDataExportResponse
-> StartSupportDataExportResponse -> Bool
Prelude.Eq, ReadPrec [StartSupportDataExportResponse]
ReadPrec StartSupportDataExportResponse
Int -> ReadS StartSupportDataExportResponse
ReadS [StartSupportDataExportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSupportDataExportResponse]
$creadListPrec :: ReadPrec [StartSupportDataExportResponse]
readPrec :: ReadPrec StartSupportDataExportResponse
$creadPrec :: ReadPrec StartSupportDataExportResponse
readList :: ReadS [StartSupportDataExportResponse]
$creadList :: ReadS [StartSupportDataExportResponse]
readsPrec :: Int -> ReadS StartSupportDataExportResponse
$creadsPrec :: Int -> ReadS StartSupportDataExportResponse
Prelude.Read, Int -> StartSupportDataExportResponse -> ShowS
[StartSupportDataExportResponse] -> ShowS
StartSupportDataExportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSupportDataExportResponse] -> ShowS
$cshowList :: [StartSupportDataExportResponse] -> ShowS
show :: StartSupportDataExportResponse -> String
$cshow :: StartSupportDataExportResponse -> String
showsPrec :: Int -> StartSupportDataExportResponse -> ShowS
$cshowsPrec :: Int -> StartSupportDataExportResponse -> ShowS
Prelude.Show, forall x.
Rep StartSupportDataExportResponse x
-> StartSupportDataExportResponse
forall x.
StartSupportDataExportResponse
-> Rep StartSupportDataExportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartSupportDataExportResponse x
-> StartSupportDataExportResponse
$cfrom :: forall x.
StartSupportDataExportResponse
-> Rep StartSupportDataExportResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSupportDataExportResponse' 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:
--
-- 'dataSetRequestId', 'startSupportDataExportResponse_dataSetRequestId' - A unique identifier representing a specific request to the
-- StartSupportDataExport operation. This identifier can be used to
-- correlate a request with notifications from the SNS topic.
--
-- 'httpStatus', 'startSupportDataExportResponse_httpStatus' - The response's http status code.
newStartSupportDataExportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSupportDataExportResponse
newStartSupportDataExportResponse :: Int -> StartSupportDataExportResponse
newStartSupportDataExportResponse Int
pHttpStatus_ =
  StartSupportDataExportResponse'
    { $sel:dataSetRequestId:StartSupportDataExportResponse' :: Maybe Text
dataSetRequestId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSupportDataExportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier representing a specific request to the
-- StartSupportDataExport operation. This identifier can be used to
-- correlate a request with notifications from the SNS topic.
startSupportDataExportResponse_dataSetRequestId :: Lens.Lens' StartSupportDataExportResponse (Prelude.Maybe Prelude.Text)
startSupportDataExportResponse_dataSetRequestId :: Lens' StartSupportDataExportResponse (Maybe Text)
startSupportDataExportResponse_dataSetRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSupportDataExportResponse' {Maybe Text
dataSetRequestId :: Maybe Text
$sel:dataSetRequestId:StartSupportDataExportResponse' :: StartSupportDataExportResponse -> Maybe Text
dataSetRequestId} -> Maybe Text
dataSetRequestId) (\s :: StartSupportDataExportResponse
s@StartSupportDataExportResponse' {} Maybe Text
a -> StartSupportDataExportResponse
s {$sel:dataSetRequestId:StartSupportDataExportResponse' :: Maybe Text
dataSetRequestId = Maybe Text
a} :: StartSupportDataExportResponse)

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

instance
  Prelude.NFData
    StartSupportDataExportResponse
  where
  rnf :: StartSupportDataExportResponse -> ()
rnf StartSupportDataExportResponse' {Int
Maybe Text
httpStatus :: Int
dataSetRequestId :: Maybe Text
$sel:httpStatus:StartSupportDataExportResponse' :: StartSupportDataExportResponse -> Int
$sel:dataSetRequestId:StartSupportDataExportResponse' :: StartSupportDataExportResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataSetRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus