{-# 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.StreamJournalToKinesis
-- 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 a journal stream for a given Amazon QLDB ledger. The stream
-- captures every document revision that is committed to the ledger\'s
-- journal and delivers the data to a specified Amazon Kinesis Data Streams
-- resource.
module Amazonka.QLDB.StreamJournalToKinesis
  ( -- * Creating a Request
    StreamJournalToKinesis (..),
    newStreamJournalToKinesis,

    -- * Request Lenses
    streamJournalToKinesis_exclusiveEndTime,
    streamJournalToKinesis_tags,
    streamJournalToKinesis_ledgerName,
    streamJournalToKinesis_roleArn,
    streamJournalToKinesis_inclusiveStartTime,
    streamJournalToKinesis_kinesisConfiguration,
    streamJournalToKinesis_streamName,

    -- * Destructuring the Response
    StreamJournalToKinesisResponse (..),
    newStreamJournalToKinesisResponse,

    -- * Response Lenses
    streamJournalToKinesisResponse_streamId,
    streamJournalToKinesisResponse_httpStatus,
  )
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:/ 'newStreamJournalToKinesis' smart constructor.
data StreamJournalToKinesis = StreamJournalToKinesis'
  { -- | The exclusive date and time that specifies when the stream ends. If you
    -- don\'t define this parameter, the stream runs indefinitely until you
    -- cancel it.
    --
    -- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
    -- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
    StreamJournalToKinesis -> Maybe POSIX
exclusiveEndTime :: Prelude.Maybe Data.POSIX,
    -- | The key-value pairs to add as tags to the stream that you want to
    -- create. Tag keys are case sensitive. Tag values are case sensitive and
    -- can be null.
    StreamJournalToKinesis -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the ledger.
    StreamJournalToKinesis -> Text
ledgerName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM role that grants QLDB
    -- permissions for a journal stream to write data records to a Kinesis Data
    -- Streams resource.
    --
    -- To pass a role to QLDB when requesting a journal stream, you must have
    -- permissions to perform the @iam:PassRole@ action on the IAM role
    -- resource. This is required for all journal stream requests.
    StreamJournalToKinesis -> Text
roleArn :: Prelude.Text,
    -- | The inclusive start date and time from which to start streaming journal
    -- data. This parameter must be in @ISO 8601@ date and time format and in
    -- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
    --
    -- The @InclusiveStartTime@ cannot be in the future and must be before
    -- @ExclusiveEndTime@.
    --
    -- If you provide an @InclusiveStartTime@ that is before the ledger\'s
    -- @CreationDateTime@, QLDB effectively defaults it to the ledger\'s
    -- @CreationDateTime@.
    StreamJournalToKinesis -> POSIX
inclusiveStartTime :: Data.POSIX,
    -- | The configuration settings of the Kinesis Data Streams destination for
    -- your stream request.
    StreamJournalToKinesis -> KinesisConfiguration
kinesisConfiguration :: KinesisConfiguration,
    -- | The name that you want to assign to the QLDB journal stream.
    -- User-defined names can help identify and indicate the purpose of a
    -- stream.
    --
    -- Your stream name must be unique among other /active/ streams for a given
    -- ledger. Stream names have the same naming constraints as ledger names,
    -- as defined in
    -- <https://docs.aws.amazon.com/qldb/latest/developerguide/limits.html#limits.naming Quotas in Amazon QLDB>
    -- in the /Amazon QLDB Developer Guide/.
    StreamJournalToKinesis -> Text
streamName :: Prelude.Text
  }
  deriving (StreamJournalToKinesis -> StreamJournalToKinesis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamJournalToKinesis -> StreamJournalToKinesis -> Bool
$c/= :: StreamJournalToKinesis -> StreamJournalToKinesis -> Bool
== :: StreamJournalToKinesis -> StreamJournalToKinesis -> Bool
$c== :: StreamJournalToKinesis -> StreamJournalToKinesis -> Bool
Prelude.Eq, ReadPrec [StreamJournalToKinesis]
ReadPrec StreamJournalToKinesis
Int -> ReadS StreamJournalToKinesis
ReadS [StreamJournalToKinesis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamJournalToKinesis]
$creadListPrec :: ReadPrec [StreamJournalToKinesis]
readPrec :: ReadPrec StreamJournalToKinesis
$creadPrec :: ReadPrec StreamJournalToKinesis
readList :: ReadS [StreamJournalToKinesis]
$creadList :: ReadS [StreamJournalToKinesis]
readsPrec :: Int -> ReadS StreamJournalToKinesis
$creadsPrec :: Int -> ReadS StreamJournalToKinesis
Prelude.Read, Int -> StreamJournalToKinesis -> ShowS
[StreamJournalToKinesis] -> ShowS
StreamJournalToKinesis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamJournalToKinesis] -> ShowS
$cshowList :: [StreamJournalToKinesis] -> ShowS
show :: StreamJournalToKinesis -> String
$cshow :: StreamJournalToKinesis -> String
showsPrec :: Int -> StreamJournalToKinesis -> ShowS
$cshowsPrec :: Int -> StreamJournalToKinesis -> ShowS
Prelude.Show, forall x. Rep StreamJournalToKinesis x -> StreamJournalToKinesis
forall x. StreamJournalToKinesis -> Rep StreamJournalToKinesis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamJournalToKinesis x -> StreamJournalToKinesis
$cfrom :: forall x. StreamJournalToKinesis -> Rep StreamJournalToKinesis x
Prelude.Generic)

-- |
-- Create a value of 'StreamJournalToKinesis' 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:
--
-- 'exclusiveEndTime', 'streamJournalToKinesis_exclusiveEndTime' - The exclusive date and time that specifies when the stream ends. If you
-- don\'t define this parameter, the stream runs indefinitely until you
-- cancel it.
--
-- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
--
-- 'tags', 'streamJournalToKinesis_tags' - The key-value pairs to add as tags to the stream that you want to
-- create. Tag keys are case sensitive. Tag values are case sensitive and
-- can be null.
--
-- 'ledgerName', 'streamJournalToKinesis_ledgerName' - The name of the ledger.
--
-- 'roleArn', 'streamJournalToKinesis_roleArn' - The Amazon Resource Name (ARN) of the IAM role that grants QLDB
-- permissions for a journal stream to write data records to a Kinesis Data
-- Streams resource.
--
-- To pass a role to QLDB when requesting a journal stream, you must have
-- permissions to perform the @iam:PassRole@ action on the IAM role
-- resource. This is required for all journal stream requests.
--
-- 'inclusiveStartTime', 'streamJournalToKinesis_inclusiveStartTime' - The inclusive start date and time from which to start streaming journal
-- data. This parameter must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
--
-- The @InclusiveStartTime@ cannot be in the future and must be before
-- @ExclusiveEndTime@.
--
-- If you provide an @InclusiveStartTime@ that is before the ledger\'s
-- @CreationDateTime@, QLDB effectively defaults it to the ledger\'s
-- @CreationDateTime@.
--
-- 'kinesisConfiguration', 'streamJournalToKinesis_kinesisConfiguration' - The configuration settings of the Kinesis Data Streams destination for
-- your stream request.
--
-- 'streamName', 'streamJournalToKinesis_streamName' - The name that you want to assign to the QLDB journal stream.
-- User-defined names can help identify and indicate the purpose of a
-- stream.
--
-- Your stream name must be unique among other /active/ streams for a given
-- ledger. Stream names have the same naming constraints as ledger names,
-- as defined in
-- <https://docs.aws.amazon.com/qldb/latest/developerguide/limits.html#limits.naming Quotas in Amazon QLDB>
-- in the /Amazon QLDB Developer Guide/.
newStreamJournalToKinesis ::
  -- | 'ledgerName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'inclusiveStartTime'
  Prelude.UTCTime ->
  -- | 'kinesisConfiguration'
  KinesisConfiguration ->
  -- | 'streamName'
  Prelude.Text ->
  StreamJournalToKinesis
newStreamJournalToKinesis :: Text
-> Text
-> UTCTime
-> KinesisConfiguration
-> Text
-> StreamJournalToKinesis
newStreamJournalToKinesis
  Text
pLedgerName_
  Text
pRoleArn_
  UTCTime
pInclusiveStartTime_
  KinesisConfiguration
pKinesisConfiguration_
  Text
pStreamName_ =
    StreamJournalToKinesis'
      { $sel:exclusiveEndTime:StreamJournalToKinesis' :: Maybe POSIX
exclusiveEndTime =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:StreamJournalToKinesis' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:ledgerName:StreamJournalToKinesis' :: Text
ledgerName = Text
pLedgerName_,
        $sel:roleArn:StreamJournalToKinesis' :: Text
roleArn = Text
pRoleArn_,
        $sel:inclusiveStartTime:StreamJournalToKinesis' :: POSIX
inclusiveStartTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pInclusiveStartTime_,
        $sel:kinesisConfiguration:StreamJournalToKinesis' :: KinesisConfiguration
kinesisConfiguration = KinesisConfiguration
pKinesisConfiguration_,
        $sel:streamName:StreamJournalToKinesis' :: Text
streamName = Text
pStreamName_
      }

-- | The exclusive date and time that specifies when the stream ends. If you
-- don\'t define this parameter, the stream runs indefinitely until you
-- cancel it.
--
-- The @ExclusiveEndTime@ must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
streamJournalToKinesis_exclusiveEndTime :: Lens.Lens' StreamJournalToKinesis (Prelude.Maybe Prelude.UTCTime)
streamJournalToKinesis_exclusiveEndTime :: Lens' StreamJournalToKinesis (Maybe UTCTime)
streamJournalToKinesis_exclusiveEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {Maybe POSIX
exclusiveEndTime :: Maybe POSIX
$sel:exclusiveEndTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe POSIX
exclusiveEndTime} -> Maybe POSIX
exclusiveEndTime) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} Maybe POSIX
a -> StreamJournalToKinesis
s {$sel:exclusiveEndTime:StreamJournalToKinesis' :: Maybe POSIX
exclusiveEndTime = Maybe POSIX
a} :: StreamJournalToKinesis) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The key-value pairs to add as tags to the stream that you want to
-- create. Tag keys are case sensitive. Tag values are case sensitive and
-- can be null.
streamJournalToKinesis_tags :: Lens.Lens' StreamJournalToKinesis (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
streamJournalToKinesis_tags :: Lens' StreamJournalToKinesis (Maybe (HashMap Text Text))
streamJournalToKinesis_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} Maybe (HashMap Text Text)
a -> StreamJournalToKinesis
s {$sel:tags:StreamJournalToKinesis' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: StreamJournalToKinesis) 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 ledger.
streamJournalToKinesis_ledgerName :: Lens.Lens' StreamJournalToKinesis Prelude.Text
streamJournalToKinesis_ledgerName :: Lens' StreamJournalToKinesis Text
streamJournalToKinesis_ledgerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {Text
ledgerName :: Text
$sel:ledgerName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
ledgerName} -> Text
ledgerName) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} Text
a -> StreamJournalToKinesis
s {$sel:ledgerName:StreamJournalToKinesis' :: Text
ledgerName = Text
a} :: StreamJournalToKinesis)

-- | The Amazon Resource Name (ARN) of the IAM role that grants QLDB
-- permissions for a journal stream to write data records to a Kinesis Data
-- Streams resource.
--
-- To pass a role to QLDB when requesting a journal stream, you must have
-- permissions to perform the @iam:PassRole@ action on the IAM role
-- resource. This is required for all journal stream requests.
streamJournalToKinesis_roleArn :: Lens.Lens' StreamJournalToKinesis Prelude.Text
streamJournalToKinesis_roleArn :: Lens' StreamJournalToKinesis Text
streamJournalToKinesis_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {Text
roleArn :: Text
$sel:roleArn:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
roleArn} -> Text
roleArn) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} Text
a -> StreamJournalToKinesis
s {$sel:roleArn:StreamJournalToKinesis' :: Text
roleArn = Text
a} :: StreamJournalToKinesis)

-- | The inclusive start date and time from which to start streaming journal
-- data. This parameter must be in @ISO 8601@ date and time format and in
-- Universal Coordinated Time (UTC). For example: @2019-06-13T21:36:34Z@.
--
-- The @InclusiveStartTime@ cannot be in the future and must be before
-- @ExclusiveEndTime@.
--
-- If you provide an @InclusiveStartTime@ that is before the ledger\'s
-- @CreationDateTime@, QLDB effectively defaults it to the ledger\'s
-- @CreationDateTime@.
streamJournalToKinesis_inclusiveStartTime :: Lens.Lens' StreamJournalToKinesis Prelude.UTCTime
streamJournalToKinesis_inclusiveStartTime :: Lens' StreamJournalToKinesis UTCTime
streamJournalToKinesis_inclusiveStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {POSIX
inclusiveStartTime :: POSIX
$sel:inclusiveStartTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> POSIX
inclusiveStartTime} -> POSIX
inclusiveStartTime) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} POSIX
a -> StreamJournalToKinesis
s {$sel:inclusiveStartTime:StreamJournalToKinesis' :: POSIX
inclusiveStartTime = POSIX
a} :: StreamJournalToKinesis) 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 Kinesis Data Streams destination for
-- your stream request.
streamJournalToKinesis_kinesisConfiguration :: Lens.Lens' StreamJournalToKinesis KinesisConfiguration
streamJournalToKinesis_kinesisConfiguration :: Lens' StreamJournalToKinesis KinesisConfiguration
streamJournalToKinesis_kinesisConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {KinesisConfiguration
kinesisConfiguration :: KinesisConfiguration
$sel:kinesisConfiguration:StreamJournalToKinesis' :: StreamJournalToKinesis -> KinesisConfiguration
kinesisConfiguration} -> KinesisConfiguration
kinesisConfiguration) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} KinesisConfiguration
a -> StreamJournalToKinesis
s {$sel:kinesisConfiguration:StreamJournalToKinesis' :: KinesisConfiguration
kinesisConfiguration = KinesisConfiguration
a} :: StreamJournalToKinesis)

-- | The name that you want to assign to the QLDB journal stream.
-- User-defined names can help identify and indicate the purpose of a
-- stream.
--
-- Your stream name must be unique among other /active/ streams for a given
-- ledger. Stream names have the same naming constraints as ledger names,
-- as defined in
-- <https://docs.aws.amazon.com/qldb/latest/developerguide/limits.html#limits.naming Quotas in Amazon QLDB>
-- in the /Amazon QLDB Developer Guide/.
streamJournalToKinesis_streamName :: Lens.Lens' StreamJournalToKinesis Prelude.Text
streamJournalToKinesis_streamName :: Lens' StreamJournalToKinesis Text
streamJournalToKinesis_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesis' {Text
streamName :: Text
$sel:streamName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
streamName} -> Text
streamName) (\s :: StreamJournalToKinesis
s@StreamJournalToKinesis' {} Text
a -> StreamJournalToKinesis
s {$sel:streamName:StreamJournalToKinesis' :: Text
streamName = Text
a} :: StreamJournalToKinesis)

instance Core.AWSRequest StreamJournalToKinesis where
  type
    AWSResponse StreamJournalToKinesis =
      StreamJournalToKinesisResponse
  request :: (Service -> Service)
-> StreamJournalToKinesis -> Request StreamJournalToKinesis
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 StreamJournalToKinesis
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StreamJournalToKinesis)))
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 -> StreamJournalToKinesisResponse
StreamJournalToKinesisResponse'
            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
"StreamId")
            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 StreamJournalToKinesis where
  hashWithSalt :: Int -> StreamJournalToKinesis -> Int
hashWithSalt Int
_salt StreamJournalToKinesis' {Maybe (HashMap Text Text)
Maybe POSIX
Text
POSIX
KinesisConfiguration
streamName :: Text
kinesisConfiguration :: KinesisConfiguration
inclusiveStartTime :: POSIX
roleArn :: Text
ledgerName :: Text
tags :: Maybe (HashMap Text Text)
exclusiveEndTime :: Maybe POSIX
$sel:streamName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:kinesisConfiguration:StreamJournalToKinesis' :: StreamJournalToKinesis -> KinesisConfiguration
$sel:inclusiveStartTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> POSIX
$sel:roleArn:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:ledgerName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:tags:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe (HashMap Text Text)
$sel:exclusiveEndTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
exclusiveEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ledgerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
inclusiveStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KinesisConfiguration
kinesisConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamName

instance Prelude.NFData StreamJournalToKinesis where
  rnf :: StreamJournalToKinesis -> ()
rnf StreamJournalToKinesis' {Maybe (HashMap Text Text)
Maybe POSIX
Text
POSIX
KinesisConfiguration
streamName :: Text
kinesisConfiguration :: KinesisConfiguration
inclusiveStartTime :: POSIX
roleArn :: Text
ledgerName :: Text
tags :: Maybe (HashMap Text Text)
exclusiveEndTime :: Maybe POSIX
$sel:streamName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:kinesisConfiguration:StreamJournalToKinesis' :: StreamJournalToKinesis -> KinesisConfiguration
$sel:inclusiveStartTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> POSIX
$sel:roleArn:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:ledgerName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:tags:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe (HashMap Text Text)
$sel:exclusiveEndTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
exclusiveEndTime
      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
ledgerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      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 KinesisConfiguration
kinesisConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
streamName

instance Data.ToHeaders StreamJournalToKinesis where
  toHeaders :: StreamJournalToKinesis -> 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 StreamJournalToKinesis where
  toJSON :: StreamJournalToKinesis -> Value
toJSON StreamJournalToKinesis' {Maybe (HashMap Text Text)
Maybe POSIX
Text
POSIX
KinesisConfiguration
streamName :: Text
kinesisConfiguration :: KinesisConfiguration
inclusiveStartTime :: POSIX
roleArn :: Text
ledgerName :: Text
tags :: Maybe (HashMap Text Text)
exclusiveEndTime :: Maybe POSIX
$sel:streamName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:kinesisConfiguration:StreamJournalToKinesis' :: StreamJournalToKinesis -> KinesisConfiguration
$sel:inclusiveStartTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> POSIX
$sel:roleArn:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:ledgerName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:tags:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe (HashMap Text Text)
$sel:exclusiveEndTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExclusiveEndTime" 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 POSIX
exclusiveEndTime,
            (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
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            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
"KinesisConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KinesisConfiguration
kinesisConfiguration
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"StreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
streamName)
          ]
      )

instance Data.ToPath StreamJournalToKinesis where
  toPath :: StreamJournalToKinesis -> ByteString
toPath StreamJournalToKinesis' {Maybe (HashMap Text Text)
Maybe POSIX
Text
POSIX
KinesisConfiguration
streamName :: Text
kinesisConfiguration :: KinesisConfiguration
inclusiveStartTime :: POSIX
roleArn :: Text
ledgerName :: Text
tags :: Maybe (HashMap Text Text)
exclusiveEndTime :: Maybe POSIX
$sel:streamName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:kinesisConfiguration:StreamJournalToKinesis' :: StreamJournalToKinesis -> KinesisConfiguration
$sel:inclusiveStartTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> POSIX
$sel:roleArn:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:ledgerName:StreamJournalToKinesis' :: StreamJournalToKinesis -> Text
$sel:tags:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe (HashMap Text Text)
$sel:exclusiveEndTime:StreamJournalToKinesis' :: StreamJournalToKinesis -> Maybe POSIX
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/ledgers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
ledgerName,
        ByteString
"/journal-kinesis-streams"
      ]

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

-- | /See:/ 'newStreamJournalToKinesisResponse' smart constructor.
data StreamJournalToKinesisResponse = StreamJournalToKinesisResponse'
  { -- | The UUID (represented in Base62-encoded text) that QLDB assigns to each
    -- QLDB journal stream.
    StreamJournalToKinesisResponse -> Maybe Text
streamId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StreamJournalToKinesisResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StreamJournalToKinesisResponse
-> StreamJournalToKinesisResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamJournalToKinesisResponse
-> StreamJournalToKinesisResponse -> Bool
$c/= :: StreamJournalToKinesisResponse
-> StreamJournalToKinesisResponse -> Bool
== :: StreamJournalToKinesisResponse
-> StreamJournalToKinesisResponse -> Bool
$c== :: StreamJournalToKinesisResponse
-> StreamJournalToKinesisResponse -> Bool
Prelude.Eq, ReadPrec [StreamJournalToKinesisResponse]
ReadPrec StreamJournalToKinesisResponse
Int -> ReadS StreamJournalToKinesisResponse
ReadS [StreamJournalToKinesisResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamJournalToKinesisResponse]
$creadListPrec :: ReadPrec [StreamJournalToKinesisResponse]
readPrec :: ReadPrec StreamJournalToKinesisResponse
$creadPrec :: ReadPrec StreamJournalToKinesisResponse
readList :: ReadS [StreamJournalToKinesisResponse]
$creadList :: ReadS [StreamJournalToKinesisResponse]
readsPrec :: Int -> ReadS StreamJournalToKinesisResponse
$creadsPrec :: Int -> ReadS StreamJournalToKinesisResponse
Prelude.Read, Int -> StreamJournalToKinesisResponse -> ShowS
[StreamJournalToKinesisResponse] -> ShowS
StreamJournalToKinesisResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamJournalToKinesisResponse] -> ShowS
$cshowList :: [StreamJournalToKinesisResponse] -> ShowS
show :: StreamJournalToKinesisResponse -> String
$cshow :: StreamJournalToKinesisResponse -> String
showsPrec :: Int -> StreamJournalToKinesisResponse -> ShowS
$cshowsPrec :: Int -> StreamJournalToKinesisResponse -> ShowS
Prelude.Show, forall x.
Rep StreamJournalToKinesisResponse x
-> StreamJournalToKinesisResponse
forall x.
StreamJournalToKinesisResponse
-> Rep StreamJournalToKinesisResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StreamJournalToKinesisResponse x
-> StreamJournalToKinesisResponse
$cfrom :: forall x.
StreamJournalToKinesisResponse
-> Rep StreamJournalToKinesisResponse x
Prelude.Generic)

-- |
-- Create a value of 'StreamJournalToKinesisResponse' 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:
--
-- 'streamId', 'streamJournalToKinesisResponse_streamId' - The UUID (represented in Base62-encoded text) that QLDB assigns to each
-- QLDB journal stream.
--
-- 'httpStatus', 'streamJournalToKinesisResponse_httpStatus' - The response's http status code.
newStreamJournalToKinesisResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StreamJournalToKinesisResponse
newStreamJournalToKinesisResponse :: Int -> StreamJournalToKinesisResponse
newStreamJournalToKinesisResponse Int
pHttpStatus_ =
  StreamJournalToKinesisResponse'
    { $sel:streamId:StreamJournalToKinesisResponse' :: Maybe Text
streamId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StreamJournalToKinesisResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The UUID (represented in Base62-encoded text) that QLDB assigns to each
-- QLDB journal stream.
streamJournalToKinesisResponse_streamId :: Lens.Lens' StreamJournalToKinesisResponse (Prelude.Maybe Prelude.Text)
streamJournalToKinesisResponse_streamId :: Lens' StreamJournalToKinesisResponse (Maybe Text)
streamJournalToKinesisResponse_streamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamJournalToKinesisResponse' {Maybe Text
streamId :: Maybe Text
$sel:streamId:StreamJournalToKinesisResponse' :: StreamJournalToKinesisResponse -> Maybe Text
streamId} -> Maybe Text
streamId) (\s :: StreamJournalToKinesisResponse
s@StreamJournalToKinesisResponse' {} Maybe Text
a -> StreamJournalToKinesisResponse
s {$sel:streamId:StreamJournalToKinesisResponse' :: Maybe Text
streamId = Maybe Text
a} :: StreamJournalToKinesisResponse)

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

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