{-# 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.UpdateLedger
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates properties on a ledger.
module Amazonka.QLDB.UpdateLedger
  ( -- * Creating a Request
    UpdateLedger (..),
    newUpdateLedger,

    -- * Request Lenses
    updateLedger_deletionProtection,
    updateLedger_kmsKey,
    updateLedger_name,

    -- * Destructuring the Response
    UpdateLedgerResponse (..),
    newUpdateLedgerResponse,

    -- * Response Lenses
    updateLedgerResponse_arn,
    updateLedgerResponse_creationDateTime,
    updateLedgerResponse_deletionProtection,
    updateLedgerResponse_encryptionDescription,
    updateLedgerResponse_name,
    updateLedgerResponse_state,
    updateLedgerResponse_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:/ 'newUpdateLedger' smart constructor.
data UpdateLedger = UpdateLedger'
  { -- | The flag that prevents a ledger from being deleted by any user. If not
    -- provided on ledger creation, this feature is enabled (@true@) by
    -- default.
    --
    -- If deletion protection is enabled, you must first disable it before you
    -- can delete the ledger. You can disable it by calling the @UpdateLedger@
    -- operation to set the flag to @false@.
    UpdateLedger -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | The key in Key Management Service (KMS) to use for encryption of data at
    -- rest in the ledger. For more information, see
    -- <https://docs.aws.amazon.com/qldb/latest/developerguide/encryption-at-rest.html Encryption at rest>
    -- in the /Amazon QLDB Developer Guide/.
    --
    -- Use one of the following options to specify this parameter:
    --
    -- -   @AWS_OWNED_KMS_KEY@: Use an KMS key that is owned and managed by
    --     Amazon Web Services on your behalf.
    --
    -- -   __Undefined__: Make no changes to the KMS key of the ledger.
    --
    -- -   __A valid symmetric customer managed KMS key__: Use the specified
    --     KMS key in your account that you create, own, and manage.
    --
    --     Amazon QLDB does not support asymmetric keys. For more information,
    --     see
    --     <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using symmetric and asymmetric keys>
    --     in the /Key Management Service Developer Guide/.
    --
    -- To specify a customer managed KMS key, you can use its key ID, Amazon
    -- Resource Name (ARN), alias name, or alias ARN. When using an alias name,
    -- prefix it with @\"alias\/\"@. To specify a key in a different Amazon Web
    -- Services account, you must use the key ARN or alias ARN.
    --
    -- For example:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Alias name: @alias\/ExampleAlias@
    --
    -- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id Key identifiers (KeyId)>
    -- in the /Key Management Service Developer Guide/.
    UpdateLedger -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | The name of the ledger.
    UpdateLedger -> Text
name :: Prelude.Text
  }
  deriving (UpdateLedger -> UpdateLedger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLedger -> UpdateLedger -> Bool
$c/= :: UpdateLedger -> UpdateLedger -> Bool
== :: UpdateLedger -> UpdateLedger -> Bool
$c== :: UpdateLedger -> UpdateLedger -> Bool
Prelude.Eq, ReadPrec [UpdateLedger]
ReadPrec UpdateLedger
Int -> ReadS UpdateLedger
ReadS [UpdateLedger]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLedger]
$creadListPrec :: ReadPrec [UpdateLedger]
readPrec :: ReadPrec UpdateLedger
$creadPrec :: ReadPrec UpdateLedger
readList :: ReadS [UpdateLedger]
$creadList :: ReadS [UpdateLedger]
readsPrec :: Int -> ReadS UpdateLedger
$creadsPrec :: Int -> ReadS UpdateLedger
Prelude.Read, Int -> UpdateLedger -> ShowS
[UpdateLedger] -> ShowS
UpdateLedger -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLedger] -> ShowS
$cshowList :: [UpdateLedger] -> ShowS
show :: UpdateLedger -> String
$cshow :: UpdateLedger -> String
showsPrec :: Int -> UpdateLedger -> ShowS
$cshowsPrec :: Int -> UpdateLedger -> ShowS
Prelude.Show, forall x. Rep UpdateLedger x -> UpdateLedger
forall x. UpdateLedger -> Rep UpdateLedger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLedger x -> UpdateLedger
$cfrom :: forall x. UpdateLedger -> Rep UpdateLedger x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLedger' 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:
--
-- 'deletionProtection', 'updateLedger_deletionProtection' - The flag that prevents a ledger from being deleted by any user. If not
-- provided on ledger creation, this feature is enabled (@true@) by
-- default.
--
-- If deletion protection is enabled, you must first disable it before you
-- can delete the ledger. You can disable it by calling the @UpdateLedger@
-- operation to set the flag to @false@.
--
-- 'kmsKey', 'updateLedger_kmsKey' - The key in Key Management Service (KMS) to use for encryption of data at
-- rest in the ledger. For more information, see
-- <https://docs.aws.amazon.com/qldb/latest/developerguide/encryption-at-rest.html Encryption at rest>
-- in the /Amazon QLDB Developer Guide/.
--
-- Use one of the following options to specify this parameter:
--
-- -   @AWS_OWNED_KMS_KEY@: Use an KMS key that is owned and managed by
--     Amazon Web Services on your behalf.
--
-- -   __Undefined__: Make no changes to the KMS key of the ledger.
--
-- -   __A valid symmetric customer managed KMS key__: Use the specified
--     KMS key in your account that you create, own, and manage.
--
--     Amazon QLDB does not support asymmetric keys. For more information,
--     see
--     <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using symmetric and asymmetric keys>
--     in the /Key Management Service Developer Guide/.
--
-- To specify a customer managed KMS key, you can use its key ID, Amazon
-- Resource Name (ARN), alias name, or alias ARN. When using an alias name,
-- prefix it with @\"alias\/\"@. To specify a key in a different Amazon Web
-- Services account, you must use the key ARN or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id Key identifiers (KeyId)>
-- in the /Key Management Service Developer Guide/.
--
-- 'name', 'updateLedger_name' - The name of the ledger.
newUpdateLedger ::
  -- | 'name'
  Prelude.Text ->
  UpdateLedger
newUpdateLedger :: Text -> UpdateLedger
newUpdateLedger Text
pName_ =
  UpdateLedger'
    { $sel:deletionProtection:UpdateLedger' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKey:UpdateLedger' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLedger' :: Text
name = Text
pName_
    }

-- | The flag that prevents a ledger from being deleted by any user. If not
-- provided on ledger creation, this feature is enabled (@true@) by
-- default.
--
-- If deletion protection is enabled, you must first disable it before you
-- can delete the ledger. You can disable it by calling the @UpdateLedger@
-- operation to set the flag to @false@.
updateLedger_deletionProtection :: Lens.Lens' UpdateLedger (Prelude.Maybe Prelude.Bool)
updateLedger_deletionProtection :: Lens' UpdateLedger (Maybe Bool)
updateLedger_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedger' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:UpdateLedger' :: UpdateLedger -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: UpdateLedger
s@UpdateLedger' {} Maybe Bool
a -> UpdateLedger
s {$sel:deletionProtection:UpdateLedger' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: UpdateLedger)

-- | The key in Key Management Service (KMS) to use for encryption of data at
-- rest in the ledger. For more information, see
-- <https://docs.aws.amazon.com/qldb/latest/developerguide/encryption-at-rest.html Encryption at rest>
-- in the /Amazon QLDB Developer Guide/.
--
-- Use one of the following options to specify this parameter:
--
-- -   @AWS_OWNED_KMS_KEY@: Use an KMS key that is owned and managed by
--     Amazon Web Services on your behalf.
--
-- -   __Undefined__: Make no changes to the KMS key of the ledger.
--
-- -   __A valid symmetric customer managed KMS key__: Use the specified
--     KMS key in your account that you create, own, and manage.
--
--     Amazon QLDB does not support asymmetric keys. For more information,
--     see
--     <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using symmetric and asymmetric keys>
--     in the /Key Management Service Developer Guide/.
--
-- To specify a customer managed KMS key, you can use its key ID, Amazon
-- Resource Name (ARN), alias name, or alias ARN. When using an alias name,
-- prefix it with @\"alias\/\"@. To specify a key in a different Amazon Web
-- Services account, you must use the key ARN or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id Key identifiers (KeyId)>
-- in the /Key Management Service Developer Guide/.
updateLedger_kmsKey :: Lens.Lens' UpdateLedger (Prelude.Maybe Prelude.Text)
updateLedger_kmsKey :: Lens' UpdateLedger (Maybe Text)
updateLedger_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedger' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:UpdateLedger' :: UpdateLedger -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: UpdateLedger
s@UpdateLedger' {} Maybe Text
a -> UpdateLedger
s {$sel:kmsKey:UpdateLedger' :: Maybe Text
kmsKey = Maybe Text
a} :: UpdateLedger)

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

instance Core.AWSRequest UpdateLedger where
  type AWSResponse UpdateLedger = UpdateLedgerResponse
  request :: (Service -> Service) -> UpdateLedger -> Request UpdateLedger
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLedger
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLedger)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe Bool
-> Maybe LedgerEncryptionDescription
-> Maybe Text
-> Maybe LedgerState
-> Int
-> UpdateLedgerResponse
UpdateLedgerResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DeletionProtection")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EncryptionDescription")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            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 UpdateLedger where
  hashWithSalt :: Int -> UpdateLedger -> Int
hashWithSalt Int
_salt UpdateLedger' {Maybe Bool
Maybe Text
Text
name :: Text
kmsKey :: Maybe Text
deletionProtection :: Maybe Bool
$sel:name:UpdateLedger' :: UpdateLedger -> Text
$sel:kmsKey:UpdateLedger' :: UpdateLedger -> Maybe Text
$sel:deletionProtection:UpdateLedger' :: UpdateLedger -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateLedger where
  rnf :: UpdateLedger -> ()
rnf UpdateLedger' {Maybe Bool
Maybe Text
Text
name :: Text
kmsKey :: Maybe Text
deletionProtection :: Maybe Bool
$sel:name:UpdateLedger' :: UpdateLedger -> Text
$sel:kmsKey:UpdateLedger' :: UpdateLedger -> Maybe Text
$sel:deletionProtection:UpdateLedger' :: UpdateLedger -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateLedger where
  toHeaders :: UpdateLedger -> 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 UpdateLedger where
  toJSON :: UpdateLedger -> Value
toJSON UpdateLedger' {Maybe Bool
Maybe Text
Text
name :: Text
kmsKey :: Maybe Text
deletionProtection :: Maybe Bool
$sel:name:UpdateLedger' :: UpdateLedger -> Text
$sel:kmsKey:UpdateLedger' :: UpdateLedger -> Maybe Text
$sel:deletionProtection:UpdateLedger' :: UpdateLedger -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeletionProtection" 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 Bool
deletionProtection,
            (Key
"KmsKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
kmsKey
          ]
      )

instance Data.ToPath UpdateLedger where
  toPath :: UpdateLedger -> ByteString
toPath UpdateLedger' {Maybe Bool
Maybe Text
Text
name :: Text
kmsKey :: Maybe Text
deletionProtection :: Maybe Bool
$sel:name:UpdateLedger' :: UpdateLedger -> Text
$sel:kmsKey:UpdateLedger' :: UpdateLedger -> Maybe Text
$sel:deletionProtection:UpdateLedger' :: UpdateLedger -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/ledgers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newUpdateLedgerResponse' smart constructor.
data UpdateLedgerResponse = UpdateLedgerResponse'
  { -- | The Amazon Resource Name (ARN) for the ledger.
    UpdateLedgerResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in epoch time format, when the ledger was created.
    -- (Epoch time format is the number of seconds elapsed since 12:00:00 AM
    -- January 1, 1970 UTC.)
    UpdateLedgerResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The flag that prevents a ledger from being deleted by any user. If not
    -- provided on ledger creation, this feature is enabled (@true@) by
    -- default.
    --
    -- If deletion protection is enabled, you must first disable it before you
    -- can delete the ledger. You can disable it by calling the @UpdateLedger@
    -- operation to set the flag to @false@.
    UpdateLedgerResponse -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | Information about the encryption of data at rest in the ledger. This
    -- includes the current status, the KMS key, and when the key became
    -- inaccessible (in the case of an error).
    UpdateLedgerResponse -> Maybe LedgerEncryptionDescription
encryptionDescription :: Prelude.Maybe LedgerEncryptionDescription,
    -- | The name of the ledger.
    UpdateLedgerResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The current status of the ledger.
    UpdateLedgerResponse -> Maybe LedgerState
state :: Prelude.Maybe LedgerState,
    -- | The response's http status code.
    UpdateLedgerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateLedgerResponse -> UpdateLedgerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLedgerResponse -> UpdateLedgerResponse -> Bool
$c/= :: UpdateLedgerResponse -> UpdateLedgerResponse -> Bool
== :: UpdateLedgerResponse -> UpdateLedgerResponse -> Bool
$c== :: UpdateLedgerResponse -> UpdateLedgerResponse -> Bool
Prelude.Eq, ReadPrec [UpdateLedgerResponse]
ReadPrec UpdateLedgerResponse
Int -> ReadS UpdateLedgerResponse
ReadS [UpdateLedgerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLedgerResponse]
$creadListPrec :: ReadPrec [UpdateLedgerResponse]
readPrec :: ReadPrec UpdateLedgerResponse
$creadPrec :: ReadPrec UpdateLedgerResponse
readList :: ReadS [UpdateLedgerResponse]
$creadList :: ReadS [UpdateLedgerResponse]
readsPrec :: Int -> ReadS UpdateLedgerResponse
$creadsPrec :: Int -> ReadS UpdateLedgerResponse
Prelude.Read, Int -> UpdateLedgerResponse -> ShowS
[UpdateLedgerResponse] -> ShowS
UpdateLedgerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLedgerResponse] -> ShowS
$cshowList :: [UpdateLedgerResponse] -> ShowS
show :: UpdateLedgerResponse -> String
$cshow :: UpdateLedgerResponse -> String
showsPrec :: Int -> UpdateLedgerResponse -> ShowS
$cshowsPrec :: Int -> UpdateLedgerResponse -> ShowS
Prelude.Show, forall x. Rep UpdateLedgerResponse x -> UpdateLedgerResponse
forall x. UpdateLedgerResponse -> Rep UpdateLedgerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLedgerResponse x -> UpdateLedgerResponse
$cfrom :: forall x. UpdateLedgerResponse -> Rep UpdateLedgerResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLedgerResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'arn', 'updateLedgerResponse_arn' - The Amazon Resource Name (ARN) for the ledger.
--
-- 'creationDateTime', 'updateLedgerResponse_creationDateTime' - The date and time, in epoch time format, when the ledger was created.
-- (Epoch time format is the number of seconds elapsed since 12:00:00 AM
-- January 1, 1970 UTC.)
--
-- 'deletionProtection', 'updateLedgerResponse_deletionProtection' - The flag that prevents a ledger from being deleted by any user. If not
-- provided on ledger creation, this feature is enabled (@true@) by
-- default.
--
-- If deletion protection is enabled, you must first disable it before you
-- can delete the ledger. You can disable it by calling the @UpdateLedger@
-- operation to set the flag to @false@.
--
-- 'encryptionDescription', 'updateLedgerResponse_encryptionDescription' - Information about the encryption of data at rest in the ledger. This
-- includes the current status, the KMS key, and when the key became
-- inaccessible (in the case of an error).
--
-- 'name', 'updateLedgerResponse_name' - The name of the ledger.
--
-- 'state', 'updateLedgerResponse_state' - The current status of the ledger.
--
-- 'httpStatus', 'updateLedgerResponse_httpStatus' - The response's http status code.
newUpdateLedgerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLedgerResponse
newUpdateLedgerResponse :: Int -> UpdateLedgerResponse
newUpdateLedgerResponse Int
pHttpStatus_ =
  UpdateLedgerResponse'
    { $sel:arn:UpdateLedgerResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:UpdateLedgerResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:UpdateLedgerResponse' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionDescription:UpdateLedgerResponse' :: Maybe LedgerEncryptionDescription
encryptionDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLedgerResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateLedgerResponse' :: Maybe LedgerState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateLedgerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The date and time, in epoch time format, when the ledger was created.
-- (Epoch time format is the number of seconds elapsed since 12:00:00 AM
-- January 1, 1970 UTC.)
updateLedgerResponse_creationDateTime :: Lens.Lens' UpdateLedgerResponse (Prelude.Maybe Prelude.UTCTime)
updateLedgerResponse_creationDateTime :: Lens' UpdateLedgerResponse (Maybe UTCTime)
updateLedgerResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedgerResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: UpdateLedgerResponse
s@UpdateLedgerResponse' {} Maybe POSIX
a -> UpdateLedgerResponse
s {$sel:creationDateTime:UpdateLedgerResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: UpdateLedgerResponse) 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 flag that prevents a ledger from being deleted by any user. If not
-- provided on ledger creation, this feature is enabled (@true@) by
-- default.
--
-- If deletion protection is enabled, you must first disable it before you
-- can delete the ledger. You can disable it by calling the @UpdateLedger@
-- operation to set the flag to @false@.
updateLedgerResponse_deletionProtection :: Lens.Lens' UpdateLedgerResponse (Prelude.Maybe Prelude.Bool)
updateLedgerResponse_deletionProtection :: Lens' UpdateLedgerResponse (Maybe Bool)
updateLedgerResponse_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedgerResponse' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: UpdateLedgerResponse
s@UpdateLedgerResponse' {} Maybe Bool
a -> UpdateLedgerResponse
s {$sel:deletionProtection:UpdateLedgerResponse' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: UpdateLedgerResponse)

-- | Information about the encryption of data at rest in the ledger. This
-- includes the current status, the KMS key, and when the key became
-- inaccessible (in the case of an error).
updateLedgerResponse_encryptionDescription :: Lens.Lens' UpdateLedgerResponse (Prelude.Maybe LedgerEncryptionDescription)
updateLedgerResponse_encryptionDescription :: Lens' UpdateLedgerResponse (Maybe LedgerEncryptionDescription)
updateLedgerResponse_encryptionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedgerResponse' {Maybe LedgerEncryptionDescription
encryptionDescription :: Maybe LedgerEncryptionDescription
$sel:encryptionDescription:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe LedgerEncryptionDescription
encryptionDescription} -> Maybe LedgerEncryptionDescription
encryptionDescription) (\s :: UpdateLedgerResponse
s@UpdateLedgerResponse' {} Maybe LedgerEncryptionDescription
a -> UpdateLedgerResponse
s {$sel:encryptionDescription:UpdateLedgerResponse' :: Maybe LedgerEncryptionDescription
encryptionDescription = Maybe LedgerEncryptionDescription
a} :: UpdateLedgerResponse)

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

-- | The current status of the ledger.
updateLedgerResponse_state :: Lens.Lens' UpdateLedgerResponse (Prelude.Maybe LedgerState)
updateLedgerResponse_state :: Lens' UpdateLedgerResponse (Maybe LedgerState)
updateLedgerResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLedgerResponse' {Maybe LedgerState
state :: Maybe LedgerState
$sel:state:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe LedgerState
state} -> Maybe LedgerState
state) (\s :: UpdateLedgerResponse
s@UpdateLedgerResponse' {} Maybe LedgerState
a -> UpdateLedgerResponse
s {$sel:state:UpdateLedgerResponse' :: Maybe LedgerState
state = Maybe LedgerState
a} :: UpdateLedgerResponse)

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

instance Prelude.NFData UpdateLedgerResponse where
  rnf :: UpdateLedgerResponse -> ()
rnf UpdateLedgerResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
Maybe LedgerEncryptionDescription
Maybe LedgerState
httpStatus :: Int
state :: Maybe LedgerState
name :: Maybe Text
encryptionDescription :: Maybe LedgerEncryptionDescription
deletionProtection :: Maybe Bool
creationDateTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:UpdateLedgerResponse' :: UpdateLedgerResponse -> Int
$sel:state:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe LedgerState
$sel:name:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe Text
$sel:encryptionDescription:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe LedgerEncryptionDescription
$sel:deletionProtection:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe Bool
$sel:creationDateTime:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe POSIX
$sel:arn:UpdateLedgerResponse' :: UpdateLedgerResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LedgerEncryptionDescription
encryptionDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LedgerState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus