{-# 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.DescribeLedger
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a ledger, including its state, permissions
-- mode, encryption at rest settings, and when it was created.
module Amazonka.QLDB.DescribeLedger
  ( -- * Creating a Request
    DescribeLedger (..),
    newDescribeLedger,

    -- * Request Lenses
    describeLedger_name,

    -- * Destructuring the Response
    DescribeLedgerResponse (..),
    newDescribeLedgerResponse,

    -- * Response Lenses
    describeLedgerResponse_arn,
    describeLedgerResponse_creationDateTime,
    describeLedgerResponse_deletionProtection,
    describeLedgerResponse_encryptionDescription,
    describeLedgerResponse_name,
    describeLedgerResponse_permissionsMode,
    describeLedgerResponse_state,
    describeLedgerResponse_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:/ 'newDescribeLedger' smart constructor.
data DescribeLedger = DescribeLedger'
  { -- | The name of the ledger that you want to describe.
    DescribeLedger -> Text
name :: Prelude.Text
  }
  deriving (DescribeLedger -> DescribeLedger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLedger -> DescribeLedger -> Bool
$c/= :: DescribeLedger -> DescribeLedger -> Bool
== :: DescribeLedger -> DescribeLedger -> Bool
$c== :: DescribeLedger -> DescribeLedger -> Bool
Prelude.Eq, ReadPrec [DescribeLedger]
ReadPrec DescribeLedger
Int -> ReadS DescribeLedger
ReadS [DescribeLedger]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLedger]
$creadListPrec :: ReadPrec [DescribeLedger]
readPrec :: ReadPrec DescribeLedger
$creadPrec :: ReadPrec DescribeLedger
readList :: ReadS [DescribeLedger]
$creadList :: ReadS [DescribeLedger]
readsPrec :: Int -> ReadS DescribeLedger
$creadsPrec :: Int -> ReadS DescribeLedger
Prelude.Read, Int -> DescribeLedger -> ShowS
[DescribeLedger] -> ShowS
DescribeLedger -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLedger] -> ShowS
$cshowList :: [DescribeLedger] -> ShowS
show :: DescribeLedger -> String
$cshow :: DescribeLedger -> String
showsPrec :: Int -> DescribeLedger -> ShowS
$cshowsPrec :: Int -> DescribeLedger -> ShowS
Prelude.Show, forall x. Rep DescribeLedger x -> DescribeLedger
forall x. DescribeLedger -> Rep DescribeLedger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLedger x -> DescribeLedger
$cfrom :: forall x. DescribeLedger -> Rep DescribeLedger x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLedger' 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:
--
-- 'name', 'describeLedger_name' - The name of the ledger that you want to describe.
newDescribeLedger ::
  -- | 'name'
  Prelude.Text ->
  DescribeLedger
newDescribeLedger :: Text -> DescribeLedger
newDescribeLedger Text
pName_ =
  DescribeLedger' {$sel:name:DescribeLedger' :: Text
name = Text
pName_}

-- | The name of the ledger that you want to describe.
describeLedger_name :: Lens.Lens' DescribeLedger Prelude.Text
describeLedger_name :: Lens' DescribeLedger Text
describeLedger_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLedger' {Text
name :: Text
$sel:name:DescribeLedger' :: DescribeLedger -> Text
name} -> Text
name) (\s :: DescribeLedger
s@DescribeLedger' {} Text
a -> DescribeLedger
s {$sel:name:DescribeLedger' :: Text
name = Text
a} :: DescribeLedger)

instance Core.AWSRequest DescribeLedger where
  type
    AWSResponse DescribeLedger =
      DescribeLedgerResponse
  request :: (Service -> Service) -> DescribeLedger -> Request DescribeLedger
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeLedger
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeLedger)))
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 PermissionsMode
-> Maybe LedgerState
-> Int
-> DescribeLedgerResponse
DescribeLedgerResponse'
            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
"PermissionsMode")
            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 DescribeLedger where
  hashWithSalt :: Int -> DescribeLedger -> Int
hashWithSalt Int
_salt DescribeLedger' {Text
name :: Text
$sel:name:DescribeLedger' :: DescribeLedger -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData DescribeLedger where
  rnf :: DescribeLedger -> ()
rnf DescribeLedger' {Text
name :: Text
$sel:name:DescribeLedger' :: DescribeLedger -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders DescribeLedger where
  toHeaders :: DescribeLedger -> 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.ToPath DescribeLedger where
  toPath :: DescribeLedger -> ByteString
toPath DescribeLedger' {Text
name :: Text
$sel:name:DescribeLedger' :: DescribeLedger -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/ledgers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newDescribeLedgerResponse' smart constructor.
data DescribeLedgerResponse = DescribeLedgerResponse'
  { -- | The Amazon Resource Name (ARN) for the ledger.
    DescribeLedgerResponse -> 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.)
    DescribeLedgerResponse -> 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@.
    DescribeLedgerResponse -> 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).
    DescribeLedgerResponse -> Maybe LedgerEncryptionDescription
encryptionDescription :: Prelude.Maybe LedgerEncryptionDescription,
    -- | The name of the ledger.
    DescribeLedgerResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The permissions mode of the ledger.
    DescribeLedgerResponse -> Maybe PermissionsMode
permissionsMode :: Prelude.Maybe PermissionsMode,
    -- | The current status of the ledger.
    DescribeLedgerResponse -> Maybe LedgerState
state :: Prelude.Maybe LedgerState,
    -- | The response's http status code.
    DescribeLedgerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeLedgerResponse -> DescribeLedgerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLedgerResponse -> DescribeLedgerResponse -> Bool
$c/= :: DescribeLedgerResponse -> DescribeLedgerResponse -> Bool
== :: DescribeLedgerResponse -> DescribeLedgerResponse -> Bool
$c== :: DescribeLedgerResponse -> DescribeLedgerResponse -> Bool
Prelude.Eq, ReadPrec [DescribeLedgerResponse]
ReadPrec DescribeLedgerResponse
Int -> ReadS DescribeLedgerResponse
ReadS [DescribeLedgerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLedgerResponse]
$creadListPrec :: ReadPrec [DescribeLedgerResponse]
readPrec :: ReadPrec DescribeLedgerResponse
$creadPrec :: ReadPrec DescribeLedgerResponse
readList :: ReadS [DescribeLedgerResponse]
$creadList :: ReadS [DescribeLedgerResponse]
readsPrec :: Int -> ReadS DescribeLedgerResponse
$creadsPrec :: Int -> ReadS DescribeLedgerResponse
Prelude.Read, Int -> DescribeLedgerResponse -> ShowS
[DescribeLedgerResponse] -> ShowS
DescribeLedgerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLedgerResponse] -> ShowS
$cshowList :: [DescribeLedgerResponse] -> ShowS
show :: DescribeLedgerResponse -> String
$cshow :: DescribeLedgerResponse -> String
showsPrec :: Int -> DescribeLedgerResponse -> ShowS
$cshowsPrec :: Int -> DescribeLedgerResponse -> ShowS
Prelude.Show, forall x. Rep DescribeLedgerResponse x -> DescribeLedgerResponse
forall x. DescribeLedgerResponse -> Rep DescribeLedgerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLedgerResponse x -> DescribeLedgerResponse
$cfrom :: forall x. DescribeLedgerResponse -> Rep DescribeLedgerResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLedgerResponse' 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', 'describeLedgerResponse_arn' - The Amazon Resource Name (ARN) for the ledger.
--
-- 'creationDateTime', 'describeLedgerResponse_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', 'describeLedgerResponse_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', 'describeLedgerResponse_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', 'describeLedgerResponse_name' - The name of the ledger.
--
-- 'permissionsMode', 'describeLedgerResponse_permissionsMode' - The permissions mode of the ledger.
--
-- 'state', 'describeLedgerResponse_state' - The current status of the ledger.
--
-- 'httpStatus', 'describeLedgerResponse_httpStatus' - The response's http status code.
newDescribeLedgerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeLedgerResponse
newDescribeLedgerResponse :: Int -> DescribeLedgerResponse
newDescribeLedgerResponse Int
pHttpStatus_ =
  DescribeLedgerResponse'
    { $sel:arn:DescribeLedgerResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:DescribeLedgerResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:DescribeLedgerResponse' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionDescription:DescribeLedgerResponse' :: Maybe LedgerEncryptionDescription
encryptionDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeLedgerResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsMode:DescribeLedgerResponse' :: Maybe PermissionsMode
permissionsMode = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DescribeLedgerResponse' :: Maybe LedgerState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeLedgerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | 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.)
describeLedgerResponse_creationDateTime :: Lens.Lens' DescribeLedgerResponse (Prelude.Maybe Prelude.UTCTime)
describeLedgerResponse_creationDateTime :: Lens' DescribeLedgerResponse (Maybe UTCTime)
describeLedgerResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLedgerResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: DescribeLedgerResponse
s@DescribeLedgerResponse' {} Maybe POSIX
a -> DescribeLedgerResponse
s {$sel:creationDateTime:DescribeLedgerResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: DescribeLedgerResponse) 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@.
describeLedgerResponse_deletionProtection :: Lens.Lens' DescribeLedgerResponse (Prelude.Maybe Prelude.Bool)
describeLedgerResponse_deletionProtection :: Lens' DescribeLedgerResponse (Maybe Bool)
describeLedgerResponse_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLedgerResponse' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: DescribeLedgerResponse
s@DescribeLedgerResponse' {} Maybe Bool
a -> DescribeLedgerResponse
s {$sel:deletionProtection:DescribeLedgerResponse' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: DescribeLedgerResponse)

-- | 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).
describeLedgerResponse_encryptionDescription :: Lens.Lens' DescribeLedgerResponse (Prelude.Maybe LedgerEncryptionDescription)
describeLedgerResponse_encryptionDescription :: Lens' DescribeLedgerResponse (Maybe LedgerEncryptionDescription)
describeLedgerResponse_encryptionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLedgerResponse' {Maybe LedgerEncryptionDescription
encryptionDescription :: Maybe LedgerEncryptionDescription
$sel:encryptionDescription:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe LedgerEncryptionDescription
encryptionDescription} -> Maybe LedgerEncryptionDescription
encryptionDescription) (\s :: DescribeLedgerResponse
s@DescribeLedgerResponse' {} Maybe LedgerEncryptionDescription
a -> DescribeLedgerResponse
s {$sel:encryptionDescription:DescribeLedgerResponse' :: Maybe LedgerEncryptionDescription
encryptionDescription = Maybe LedgerEncryptionDescription
a} :: DescribeLedgerResponse)

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

-- | The permissions mode of the ledger.
describeLedgerResponse_permissionsMode :: Lens.Lens' DescribeLedgerResponse (Prelude.Maybe PermissionsMode)
describeLedgerResponse_permissionsMode :: Lens' DescribeLedgerResponse (Maybe PermissionsMode)
describeLedgerResponse_permissionsMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLedgerResponse' {Maybe PermissionsMode
permissionsMode :: Maybe PermissionsMode
$sel:permissionsMode:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe PermissionsMode
permissionsMode} -> Maybe PermissionsMode
permissionsMode) (\s :: DescribeLedgerResponse
s@DescribeLedgerResponse' {} Maybe PermissionsMode
a -> DescribeLedgerResponse
s {$sel:permissionsMode:DescribeLedgerResponse' :: Maybe PermissionsMode
permissionsMode = Maybe PermissionsMode
a} :: DescribeLedgerResponse)

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

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

instance Prelude.NFData DescribeLedgerResponse where
  rnf :: DescribeLedgerResponse -> ()
rnf DescribeLedgerResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
Maybe LedgerEncryptionDescription
Maybe LedgerState
Maybe PermissionsMode
httpStatus :: Int
state :: Maybe LedgerState
permissionsMode :: Maybe PermissionsMode
name :: Maybe Text
encryptionDescription :: Maybe LedgerEncryptionDescription
deletionProtection :: Maybe Bool
creationDateTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:DescribeLedgerResponse' :: DescribeLedgerResponse -> Int
$sel:state:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe LedgerState
$sel:permissionsMode:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe PermissionsMode
$sel:name:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe Text
$sel:encryptionDescription:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe LedgerEncryptionDescription
$sel:deletionProtection:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe Bool
$sel:creationDateTime:DescribeLedgerResponse' :: DescribeLedgerResponse -> Maybe POSIX
$sel:arn:DescribeLedgerResponse' :: DescribeLedgerResponse -> 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 PermissionsMode
permissionsMode
      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