{-# 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.GetDigest
-- 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 the digest of a ledger at the latest committed block in the
-- journal. The response includes a 256-bit hash value and a block address.
module Amazonka.QLDB.GetDigest
  ( -- * Creating a Request
    GetDigest (..),
    newGetDigest,

    -- * Request Lenses
    getDigest_name,

    -- * Destructuring the Response
    GetDigestResponse (..),
    newGetDigestResponse,

    -- * Response Lenses
    getDigestResponse_httpStatus,
    getDigestResponse_digest,
    getDigestResponse_digestTipAddress,
  )
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:/ 'newGetDigest' smart constructor.
data GetDigest = GetDigest'
  { -- | The name of the ledger.
    GetDigest -> Text
name :: Prelude.Text
  }
  deriving (GetDigest -> GetDigest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDigest -> GetDigest -> Bool
$c/= :: GetDigest -> GetDigest -> Bool
== :: GetDigest -> GetDigest -> Bool
$c== :: GetDigest -> GetDigest -> Bool
Prelude.Eq, ReadPrec [GetDigest]
ReadPrec GetDigest
Int -> ReadS GetDigest
ReadS [GetDigest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDigest]
$creadListPrec :: ReadPrec [GetDigest]
readPrec :: ReadPrec GetDigest
$creadPrec :: ReadPrec GetDigest
readList :: ReadS [GetDigest]
$creadList :: ReadS [GetDigest]
readsPrec :: Int -> ReadS GetDigest
$creadsPrec :: Int -> ReadS GetDigest
Prelude.Read, Int -> GetDigest -> ShowS
[GetDigest] -> ShowS
GetDigest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDigest] -> ShowS
$cshowList :: [GetDigest] -> ShowS
show :: GetDigest -> String
$cshow :: GetDigest -> String
showsPrec :: Int -> GetDigest -> ShowS
$cshowsPrec :: Int -> GetDigest -> ShowS
Prelude.Show, forall x. Rep GetDigest x -> GetDigest
forall x. GetDigest -> Rep GetDigest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDigest x -> GetDigest
$cfrom :: forall x. GetDigest -> Rep GetDigest x
Prelude.Generic)

-- |
-- Create a value of 'GetDigest' 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', 'getDigest_name' - The name of the ledger.
newGetDigest ::
  -- | 'name'
  Prelude.Text ->
  GetDigest
newGetDigest :: Text -> GetDigest
newGetDigest Text
pName_ = GetDigest' {$sel:name:GetDigest' :: Text
name = Text
pName_}

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

instance Core.AWSRequest GetDigest where
  type AWSResponse GetDigest = GetDigestResponse
  request :: (Service -> Service) -> GetDigest -> Request GetDigest
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 GetDigest
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDigest)))
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 -> Base64 -> Sensitive ValueHolder -> GetDigestResponse
GetDigestResponse'
            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
"Digest")
            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
"DigestTipAddress")
      )

instance Prelude.Hashable GetDigest where
  hashWithSalt :: Int -> GetDigest -> Int
hashWithSalt Int
_salt GetDigest' {Text
name :: Text
$sel:name:GetDigest' :: GetDigest -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders GetDigest where
  toHeaders :: GetDigest -> 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 GetDigest where
  toJSON :: GetDigest -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newGetDigestResponse' smart constructor.
data GetDigestResponse = GetDigestResponse'
  { -- | The response's http status code.
    GetDigestResponse -> Int
httpStatus :: Prelude.Int,
    -- | The 256-bit hash value representing the digest returned by a @GetDigest@
    -- request.
    GetDigestResponse -> Base64
digest :: Data.Base64,
    -- | The latest block location covered by the digest that you requested. An
    -- address is an Amazon Ion structure that has two fields: @strandId@ and
    -- @sequenceNo@.
    GetDigestResponse -> Sensitive ValueHolder
digestTipAddress :: Data.Sensitive ValueHolder
  }
  deriving (GetDigestResponse -> GetDigestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDigestResponse -> GetDigestResponse -> Bool
$c/= :: GetDigestResponse -> GetDigestResponse -> Bool
== :: GetDigestResponse -> GetDigestResponse -> Bool
$c== :: GetDigestResponse -> GetDigestResponse -> Bool
Prelude.Eq, Int -> GetDigestResponse -> ShowS
[GetDigestResponse] -> ShowS
GetDigestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDigestResponse] -> ShowS
$cshowList :: [GetDigestResponse] -> ShowS
show :: GetDigestResponse -> String
$cshow :: GetDigestResponse -> String
showsPrec :: Int -> GetDigestResponse -> ShowS
$cshowsPrec :: Int -> GetDigestResponse -> ShowS
Prelude.Show, forall x. Rep GetDigestResponse x -> GetDigestResponse
forall x. GetDigestResponse -> Rep GetDigestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDigestResponse x -> GetDigestResponse
$cfrom :: forall x. GetDigestResponse -> Rep GetDigestResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDigestResponse' 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', 'getDigestResponse_httpStatus' - The response's http status code.
--
-- 'digest', 'getDigestResponse_digest' - The 256-bit hash value representing the digest returned by a @GetDigest@
-- request.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'digestTipAddress', 'getDigestResponse_digestTipAddress' - The latest block location covered by the digest that you requested. An
-- address is an Amazon Ion structure that has two fields: @strandId@ and
-- @sequenceNo@.
newGetDigestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'digest'
  Prelude.ByteString ->
  -- | 'digestTipAddress'
  ValueHolder ->
  GetDigestResponse
newGetDigestResponse :: Int -> ByteString -> ValueHolder -> GetDigestResponse
newGetDigestResponse
  Int
pHttpStatus_
  ByteString
pDigest_
  ValueHolder
pDigestTipAddress_ =
    GetDigestResponse'
      { $sel:httpStatus:GetDigestResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:digest:GetDigestResponse' :: Base64
digest = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pDigest_,
        $sel:digestTipAddress:GetDigestResponse' :: Sensitive ValueHolder
digestTipAddress =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ValueHolder
pDigestTipAddress_
      }

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

-- | The 256-bit hash value representing the digest returned by a @GetDigest@
-- request.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
getDigestResponse_digest :: Lens.Lens' GetDigestResponse Prelude.ByteString
getDigestResponse_digest :: Lens' GetDigestResponse ByteString
getDigestResponse_digest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDigestResponse' {Base64
digest :: Base64
$sel:digest:GetDigestResponse' :: GetDigestResponse -> Base64
digest} -> Base64
digest) (\s :: GetDigestResponse
s@GetDigestResponse' {} Base64
a -> GetDigestResponse
s {$sel:digest:GetDigestResponse' :: Base64
digest = Base64
a} :: GetDigestResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The latest block location covered by the digest that you requested. An
-- address is an Amazon Ion structure that has two fields: @strandId@ and
-- @sequenceNo@.
getDigestResponse_digestTipAddress :: Lens.Lens' GetDigestResponse ValueHolder
getDigestResponse_digestTipAddress :: Lens' GetDigestResponse ValueHolder
getDigestResponse_digestTipAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDigestResponse' {Sensitive ValueHolder
digestTipAddress :: Sensitive ValueHolder
$sel:digestTipAddress:GetDigestResponse' :: GetDigestResponse -> Sensitive ValueHolder
digestTipAddress} -> Sensitive ValueHolder
digestTipAddress) (\s :: GetDigestResponse
s@GetDigestResponse' {} Sensitive ValueHolder
a -> GetDigestResponse
s {$sel:digestTipAddress:GetDigestResponse' :: Sensitive ValueHolder
digestTipAddress = Sensitive ValueHolder
a} :: GetDigestResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Prelude.NFData GetDigestResponse where
  rnf :: GetDigestResponse -> ()
rnf GetDigestResponse' {Int
Base64
Sensitive ValueHolder
digestTipAddress :: Sensitive ValueHolder
digest :: Base64
httpStatus :: Int
$sel:digestTipAddress:GetDigestResponse' :: GetDigestResponse -> Sensitive ValueHolder
$sel:digest:GetDigestResponse' :: GetDigestResponse -> Base64
$sel:httpStatus:GetDigestResponse' :: GetDigestResponse -> 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 Base64
digest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive ValueHolder
digestTipAddress