{-# 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.QLDB.ExportJournalToS3
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Exports journal contents within a date and time range from a ledger into
-- a specified Amazon Simple Storage Service (Amazon S3) bucket. A journal
-- export job can write the data objects in either the text or binary
-- representation of Amazon Ion format, or in /JSON Lines/ text format.
--
-- In JSON Lines format, each journal block in the exported data object is
-- a valid JSON object that is delimited by a newline. You can use this
-- format to easily integrate JSON exports with analytics tools such as
-- Glue and Amazon Athena because these services can parse
-- newline-delimited JSON automatically. For more information about the
-- format, see <https://jsonlines.org/ JSON Lines>.
--
-- If the ledger with the given @Name@ doesn\'t exist, then throws
-- @ResourceNotFoundException@.
--
-- If the ledger with the given @Name@ is in @CREATING@ status, then throws
-- @ResourcePreconditionNotMetException@.
--
-- You can initiate up to two concurrent journal export requests for each
-- ledger. Beyond this limit, journal export requests throw
-- @LimitExceededException@.
module Amazonka.QLDB.ExportJournalToS3
  ( -- * Creating a Request
    ExportJournalToS3 (..),
    newExportJournalToS3,

    -- * Request Lenses
    exportJournalToS3_outputFormat,
    exportJournalToS3_name,
    exportJournalToS3_inclusiveStartTime,
    exportJournalToS3_exclusiveEndTime,
    exportJournalToS3_s3ExportConfiguration,
    exportJournalToS3_roleArn,

    -- * Destructuring the Response
    ExportJournalToS3Response (..),
    newExportJournalToS3Response,

    -- * Response Lenses
    exportJournalToS3Response_httpStatus,
    exportJournalToS3Response_exportId,
  )
where

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 Amazonka.QLDB.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newExportJournalToS3' smart constructor.
data ExportJournalToS3 = ExportJournalToS3'
  { -- | The output format of your exported journal data. If this parameter is
    -- not specified, the exported data defaults to @ION_TEXT@ format.
    ExportJournalToS3 -> Maybe OutputFormat
outputFormat :: Prelude.Maybe OutputFormat,
    -- | The name of the ledger.
    ExportJournalToS3 -> Text
name :: Prelude.Text,
    -- | The inclusive start date and time for the range of journal contents to
    -- export.
    --
    -- The @InclusiveStartTime@ must be in @ISO 8601@ date and time format and
    -- in Universal Coordinated Time (UTC). For example:
    -- @2019-06-13T21:36:34Z@.
    --
    -- The @InclusiveStartTime@ must be before @ExclusiveEndTime@.
    --
    -- If you provide an @InclusiveStartTime@ that is before the ledger\'s
    -- @CreationDateTime@, Amazon QLDB defaults it to the ledger\'s
    -- @CreationDateTime@.
    ExportJournalToS3 -> POSIX
inclusiveStartTime :: Data.POSIX,
    -- | The exclusive end date and time for the range of journal contents to
    -- export.
    --
    -- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
    -- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
    --
    -- The @ExclusiveEndTime@ must be less than or equal to the current UTC
    -- date and time.
    ExportJournalToS3 -> POSIX
exclusiveEndTime :: Data.POSIX,
    -- | The configuration settings of the Amazon S3 bucket destination for your
    -- export request.
    ExportJournalToS3 -> S3ExportConfiguration
s3ExportConfiguration :: S3ExportConfiguration,
    -- | The Amazon Resource Name (ARN) of the IAM role that grants QLDB
    -- permissions for a journal export job to do the following:
    --
    -- -   Write objects into your Amazon Simple Storage Service (Amazon S3)
    --     bucket.
    --
    -- -   (Optional) Use your customer managed key in Key Management Service
    --     (KMS) for server-side encryption of your exported data.
    --
    -- To pass a role to QLDB when requesting a journal export, you must have
    -- permissions to perform the @iam:PassRole@ action on the IAM role
    -- resource. This is required for all journal export requests.
    ExportJournalToS3 -> Text
roleArn :: Prelude.Text
  }
  deriving (ExportJournalToS3 -> ExportJournalToS3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportJournalToS3 -> ExportJournalToS3 -> Bool
$c/= :: ExportJournalToS3 -> ExportJournalToS3 -> Bool
== :: ExportJournalToS3 -> ExportJournalToS3 -> Bool
$c== :: ExportJournalToS3 -> ExportJournalToS3 -> Bool
Prelude.Eq, ReadPrec [ExportJournalToS3]
ReadPrec ExportJournalToS3
Int -> ReadS ExportJournalToS3
ReadS [ExportJournalToS3]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportJournalToS3]
$creadListPrec :: ReadPrec [ExportJournalToS3]
readPrec :: ReadPrec ExportJournalToS3
$creadPrec :: ReadPrec ExportJournalToS3
readList :: ReadS [ExportJournalToS3]
$creadList :: ReadS [ExportJournalToS3]
readsPrec :: Int -> ReadS ExportJournalToS3
$creadsPrec :: Int -> ReadS ExportJournalToS3
Prelude.Read, Int -> ExportJournalToS3 -> ShowS
[ExportJournalToS3] -> ShowS
ExportJournalToS3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportJournalToS3] -> ShowS
$cshowList :: [ExportJournalToS3] -> ShowS
show :: ExportJournalToS3 -> String
$cshow :: ExportJournalToS3 -> String
showsPrec :: Int -> ExportJournalToS3 -> ShowS
$cshowsPrec :: Int -> ExportJournalToS3 -> ShowS
Prelude.Show, forall x. Rep ExportJournalToS3 x -> ExportJournalToS3
forall x. ExportJournalToS3 -> Rep ExportJournalToS3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportJournalToS3 x -> ExportJournalToS3
$cfrom :: forall x. ExportJournalToS3 -> Rep ExportJournalToS3 x
Prelude.Generic)

-- |
-- Create a value of 'ExportJournalToS3' 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:
--
-- 'outputFormat', 'exportJournalToS3_outputFormat' - The output format of your exported journal data. If this parameter is
-- not specified, the exported data defaults to @ION_TEXT@ format.
--
-- 'name', 'exportJournalToS3_name' - The name of the ledger.
--
-- 'inclusiveStartTime', 'exportJournalToS3_inclusiveStartTime' - The inclusive start date and time for the range of journal contents to
-- export.
--
-- The @InclusiveStartTime@ must be in @ISO 8601@ date and time format and
-- in Universal Coordinated Time (UTC). For example:
-- @2019-06-13T21:36:34Z@.
--
-- The @InclusiveStartTime@ must be before @ExclusiveEndTime@.
--
-- If you provide an @InclusiveStartTime@ that is before the ledger\'s
-- @CreationDateTime@, Amazon QLDB defaults it to the ledger\'s
-- @CreationDateTime@.
--
-- 'exclusiveEndTime', 'exportJournalToS3_exclusiveEndTime' - The exclusive end date and time for the range of journal contents to
-- export.
--
-- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
--
-- The @ExclusiveEndTime@ must be less than or equal to the current UTC
-- date and time.
--
-- 's3ExportConfiguration', 'exportJournalToS3_s3ExportConfiguration' - The configuration settings of the Amazon S3 bucket destination for your
-- export request.
--
-- 'roleArn', 'exportJournalToS3_roleArn' - The Amazon Resource Name (ARN) of the IAM role that grants QLDB
-- permissions for a journal export job to do the following:
--
-- -   Write objects into your Amazon Simple Storage Service (Amazon S3)
--     bucket.
--
-- -   (Optional) Use your customer managed key in Key Management Service
--     (KMS) for server-side encryption of your exported data.
--
-- To pass a role to QLDB when requesting a journal export, you must have
-- permissions to perform the @iam:PassRole@ action on the IAM role
-- resource. This is required for all journal export requests.
newExportJournalToS3 ::
  -- | 'name'
  Prelude.Text ->
  -- | 'inclusiveStartTime'
  Prelude.UTCTime ->
  -- | 'exclusiveEndTime'
  Prelude.UTCTime ->
  -- | 's3ExportConfiguration'
  S3ExportConfiguration ->
  -- | 'roleArn'
  Prelude.Text ->
  ExportJournalToS3
newExportJournalToS3 :: Text
-> UTCTime
-> UTCTime
-> S3ExportConfiguration
-> Text
-> ExportJournalToS3
newExportJournalToS3
  Text
pName_
  UTCTime
pInclusiveStartTime_
  UTCTime
pExclusiveEndTime_
  S3ExportConfiguration
pS3ExportConfiguration_
  Text
pRoleArn_ =
    ExportJournalToS3'
      { $sel:outputFormat:ExportJournalToS3' :: Maybe OutputFormat
outputFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:name:ExportJournalToS3' :: Text
name = Text
pName_,
        $sel:inclusiveStartTime:ExportJournalToS3' :: POSIX
inclusiveStartTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pInclusiveStartTime_,
        $sel:exclusiveEndTime:ExportJournalToS3' :: POSIX
exclusiveEndTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pExclusiveEndTime_,
        $sel:s3ExportConfiguration:ExportJournalToS3' :: S3ExportConfiguration
s3ExportConfiguration = S3ExportConfiguration
pS3ExportConfiguration_,
        $sel:roleArn:ExportJournalToS3' :: Text
roleArn = Text
pRoleArn_
      }

-- | The output format of your exported journal data. If this parameter is
-- not specified, the exported data defaults to @ION_TEXT@ format.
exportJournalToS3_outputFormat :: Lens.Lens' ExportJournalToS3 (Prelude.Maybe OutputFormat)
exportJournalToS3_outputFormat :: Lens' ExportJournalToS3 (Maybe OutputFormat)
exportJournalToS3_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3' {Maybe OutputFormat
outputFormat :: Maybe OutputFormat
$sel:outputFormat:ExportJournalToS3' :: ExportJournalToS3 -> Maybe OutputFormat
outputFormat} -> Maybe OutputFormat
outputFormat) (\s :: ExportJournalToS3
s@ExportJournalToS3' {} Maybe OutputFormat
a -> ExportJournalToS3
s {$sel:outputFormat:ExportJournalToS3' :: Maybe OutputFormat
outputFormat = Maybe OutputFormat
a} :: ExportJournalToS3)

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

-- | The inclusive start date and time for the range of journal contents to
-- export.
--
-- The @InclusiveStartTime@ must be in @ISO 8601@ date and time format and
-- in Universal Coordinated Time (UTC). For example:
-- @2019-06-13T21:36:34Z@.
--
-- The @InclusiveStartTime@ must be before @ExclusiveEndTime@.
--
-- If you provide an @InclusiveStartTime@ that is before the ledger\'s
-- @CreationDateTime@, Amazon QLDB defaults it to the ledger\'s
-- @CreationDateTime@.
exportJournalToS3_inclusiveStartTime :: Lens.Lens' ExportJournalToS3 Prelude.UTCTime
exportJournalToS3_inclusiveStartTime :: Lens' ExportJournalToS3 UTCTime
exportJournalToS3_inclusiveStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3' {POSIX
inclusiveStartTime :: POSIX
$sel:inclusiveStartTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
inclusiveStartTime} -> POSIX
inclusiveStartTime) (\s :: ExportJournalToS3
s@ExportJournalToS3' {} POSIX
a -> ExportJournalToS3
s {$sel:inclusiveStartTime:ExportJournalToS3' :: POSIX
inclusiveStartTime = POSIX
a} :: ExportJournalToS3) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The exclusive end date and time for the range of journal contents to
-- export.
--
-- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
--
-- The @ExclusiveEndTime@ must be less than or equal to the current UTC
-- date and time.
exportJournalToS3_exclusiveEndTime :: Lens.Lens' ExportJournalToS3 Prelude.UTCTime
exportJournalToS3_exclusiveEndTime :: Lens' ExportJournalToS3 UTCTime
exportJournalToS3_exclusiveEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3' {POSIX
exclusiveEndTime :: POSIX
$sel:exclusiveEndTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
exclusiveEndTime} -> POSIX
exclusiveEndTime) (\s :: ExportJournalToS3
s@ExportJournalToS3' {} POSIX
a -> ExportJournalToS3
s {$sel:exclusiveEndTime:ExportJournalToS3' :: POSIX
exclusiveEndTime = POSIX
a} :: ExportJournalToS3) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The configuration settings of the Amazon S3 bucket destination for your
-- export request.
exportJournalToS3_s3ExportConfiguration :: Lens.Lens' ExportJournalToS3 S3ExportConfiguration
exportJournalToS3_s3ExportConfiguration :: Lens' ExportJournalToS3 S3ExportConfiguration
exportJournalToS3_s3ExportConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3' {S3ExportConfiguration
s3ExportConfiguration :: S3ExportConfiguration
$sel:s3ExportConfiguration:ExportJournalToS3' :: ExportJournalToS3 -> S3ExportConfiguration
s3ExportConfiguration} -> S3ExportConfiguration
s3ExportConfiguration) (\s :: ExportJournalToS3
s@ExportJournalToS3' {} S3ExportConfiguration
a -> ExportJournalToS3
s {$sel:s3ExportConfiguration:ExportJournalToS3' :: S3ExportConfiguration
s3ExportConfiguration = S3ExportConfiguration
a} :: ExportJournalToS3)

-- | The Amazon Resource Name (ARN) of the IAM role that grants QLDB
-- permissions for a journal export job to do the following:
--
-- -   Write objects into your Amazon Simple Storage Service (Amazon S3)
--     bucket.
--
-- -   (Optional) Use your customer managed key in Key Management Service
--     (KMS) for server-side encryption of your exported data.
--
-- To pass a role to QLDB when requesting a journal export, you must have
-- permissions to perform the @iam:PassRole@ action on the IAM role
-- resource. This is required for all journal export requests.
exportJournalToS3_roleArn :: Lens.Lens' ExportJournalToS3 Prelude.Text
exportJournalToS3_roleArn :: Lens' ExportJournalToS3 Text
exportJournalToS3_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3' {Text
roleArn :: Text
$sel:roleArn:ExportJournalToS3' :: ExportJournalToS3 -> Text
roleArn} -> Text
roleArn) (\s :: ExportJournalToS3
s@ExportJournalToS3' {} Text
a -> ExportJournalToS3
s {$sel:roleArn:ExportJournalToS3' :: Text
roleArn = Text
a} :: ExportJournalToS3)

instance Core.AWSRequest ExportJournalToS3 where
  type
    AWSResponse ExportJournalToS3 =
      ExportJournalToS3Response
  request :: (Service -> Service)
-> ExportJournalToS3 -> Request ExportJournalToS3
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 ExportJournalToS3
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ExportJournalToS3)))
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 ->
          Int -> Text -> ExportJournalToS3Response
ExportJournalToS3Response'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ExportId")
      )

instance Prelude.Hashable ExportJournalToS3 where
  hashWithSalt :: Int -> ExportJournalToS3 -> Int
hashWithSalt Int
_salt ExportJournalToS3' {Maybe OutputFormat
Text
POSIX
S3ExportConfiguration
roleArn :: Text
s3ExportConfiguration :: S3ExportConfiguration
exclusiveEndTime :: POSIX
inclusiveStartTime :: POSIX
name :: Text
outputFormat :: Maybe OutputFormat
$sel:roleArn:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:s3ExportConfiguration:ExportJournalToS3' :: ExportJournalToS3 -> S3ExportConfiguration
$sel:exclusiveEndTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:inclusiveStartTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:name:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:outputFormat:ExportJournalToS3' :: ExportJournalToS3 -> Maybe OutputFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputFormat
outputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
inclusiveStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
exclusiveEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3ExportConfiguration
s3ExportConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData ExportJournalToS3 where
  rnf :: ExportJournalToS3 -> ()
rnf ExportJournalToS3' {Maybe OutputFormat
Text
POSIX
S3ExportConfiguration
roleArn :: Text
s3ExportConfiguration :: S3ExportConfiguration
exclusiveEndTime :: POSIX
inclusiveStartTime :: POSIX
name :: Text
outputFormat :: Maybe OutputFormat
$sel:roleArn:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:s3ExportConfiguration:ExportJournalToS3' :: ExportJournalToS3 -> S3ExportConfiguration
$sel:exclusiveEndTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:inclusiveStartTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:name:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:outputFormat:ExportJournalToS3' :: ExportJournalToS3 -> Maybe OutputFormat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputFormat
outputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
inclusiveStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
exclusiveEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3ExportConfiguration
s3ExportConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders ExportJournalToS3 where
  toHeaders :: ExportJournalToS3 -> 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.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ExportJournalToS3 where
  toJSON :: ExportJournalToS3 -> Value
toJSON ExportJournalToS3' {Maybe OutputFormat
Text
POSIX
S3ExportConfiguration
roleArn :: Text
s3ExportConfiguration :: S3ExportConfiguration
exclusiveEndTime :: POSIX
inclusiveStartTime :: POSIX
name :: Text
outputFormat :: Maybe OutputFormat
$sel:roleArn:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:s3ExportConfiguration:ExportJournalToS3' :: ExportJournalToS3 -> S3ExportConfiguration
$sel:exclusiveEndTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:inclusiveStartTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:name:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:outputFormat:ExportJournalToS3' :: ExportJournalToS3 -> Maybe OutputFormat
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OutputFormat" 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 OutputFormat
outputFormat,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InclusiveStartTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
inclusiveStartTime),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExclusiveEndTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
exclusiveEndTime),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"S3ExportConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3ExportConfiguration
s3ExportConfiguration
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

instance Data.ToPath ExportJournalToS3 where
  toPath :: ExportJournalToS3 -> ByteString
toPath ExportJournalToS3' {Maybe OutputFormat
Text
POSIX
S3ExportConfiguration
roleArn :: Text
s3ExportConfiguration :: S3ExportConfiguration
exclusiveEndTime :: POSIX
inclusiveStartTime :: POSIX
name :: Text
outputFormat :: Maybe OutputFormat
$sel:roleArn:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:s3ExportConfiguration:ExportJournalToS3' :: ExportJournalToS3 -> S3ExportConfiguration
$sel:exclusiveEndTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:inclusiveStartTime:ExportJournalToS3' :: ExportJournalToS3 -> POSIX
$sel:name:ExportJournalToS3' :: ExportJournalToS3 -> Text
$sel:outputFormat:ExportJournalToS3' :: ExportJournalToS3 -> Maybe OutputFormat
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/ledgers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name, ByteString
"/journal-s3-exports"]

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

-- | /See:/ 'newExportJournalToS3Response' smart constructor.
data ExportJournalToS3Response = ExportJournalToS3Response'
  { -- | The response's http status code.
    ExportJournalToS3Response -> Int
httpStatus :: Prelude.Int,
    -- | The UUID (represented in Base62-encoded text) that QLDB assigns to each
    -- journal export job.
    --
    -- To describe your export request and check the status of the job, you can
    -- use @ExportId@ to call @DescribeJournalS3Export@.
    ExportJournalToS3Response -> Text
exportId :: Prelude.Text
  }
  deriving (ExportJournalToS3Response -> ExportJournalToS3Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportJournalToS3Response -> ExportJournalToS3Response -> Bool
$c/= :: ExportJournalToS3Response -> ExportJournalToS3Response -> Bool
== :: ExportJournalToS3Response -> ExportJournalToS3Response -> Bool
$c== :: ExportJournalToS3Response -> ExportJournalToS3Response -> Bool
Prelude.Eq, ReadPrec [ExportJournalToS3Response]
ReadPrec ExportJournalToS3Response
Int -> ReadS ExportJournalToS3Response
ReadS [ExportJournalToS3Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportJournalToS3Response]
$creadListPrec :: ReadPrec [ExportJournalToS3Response]
readPrec :: ReadPrec ExportJournalToS3Response
$creadPrec :: ReadPrec ExportJournalToS3Response
readList :: ReadS [ExportJournalToS3Response]
$creadList :: ReadS [ExportJournalToS3Response]
readsPrec :: Int -> ReadS ExportJournalToS3Response
$creadsPrec :: Int -> ReadS ExportJournalToS3Response
Prelude.Read, Int -> ExportJournalToS3Response -> ShowS
[ExportJournalToS3Response] -> ShowS
ExportJournalToS3Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportJournalToS3Response] -> ShowS
$cshowList :: [ExportJournalToS3Response] -> ShowS
show :: ExportJournalToS3Response -> String
$cshow :: ExportJournalToS3Response -> String
showsPrec :: Int -> ExportJournalToS3Response -> ShowS
$cshowsPrec :: Int -> ExportJournalToS3Response -> ShowS
Prelude.Show, forall x.
Rep ExportJournalToS3Response x -> ExportJournalToS3Response
forall x.
ExportJournalToS3Response -> Rep ExportJournalToS3Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportJournalToS3Response x -> ExportJournalToS3Response
$cfrom :: forall x.
ExportJournalToS3Response -> Rep ExportJournalToS3Response x
Prelude.Generic)

-- |
-- Create a value of 'ExportJournalToS3Response' 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', 'exportJournalToS3Response_httpStatus' - The response's http status code.
--
-- 'exportId', 'exportJournalToS3Response_exportId' - The UUID (represented in Base62-encoded text) that QLDB assigns to each
-- journal export job.
--
-- To describe your export request and check the status of the job, you can
-- use @ExportId@ to call @DescribeJournalS3Export@.
newExportJournalToS3Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'exportId'
  Prelude.Text ->
  ExportJournalToS3Response
newExportJournalToS3Response :: Int -> Text -> ExportJournalToS3Response
newExportJournalToS3Response Int
pHttpStatus_ Text
pExportId_ =
  ExportJournalToS3Response'
    { $sel:httpStatus:ExportJournalToS3Response' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:exportId:ExportJournalToS3Response' :: Text
exportId = Text
pExportId_
    }

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

-- | The UUID (represented in Base62-encoded text) that QLDB assigns to each
-- journal export job.
--
-- To describe your export request and check the status of the job, you can
-- use @ExportId@ to call @DescribeJournalS3Export@.
exportJournalToS3Response_exportId :: Lens.Lens' ExportJournalToS3Response Prelude.Text
exportJournalToS3Response_exportId :: Lens' ExportJournalToS3Response Text
exportJournalToS3Response_exportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportJournalToS3Response' {Text
exportId :: Text
$sel:exportId:ExportJournalToS3Response' :: ExportJournalToS3Response -> Text
exportId} -> Text
exportId) (\s :: ExportJournalToS3Response
s@ExportJournalToS3Response' {} Text
a -> ExportJournalToS3Response
s {$sel:exportId:ExportJournalToS3Response' :: Text
exportId = Text
a} :: ExportJournalToS3Response)

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