{-# 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.KMS.Verify
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Verifies a digital signature that was generated by the Sign operation.
--
-- Verification confirms that an authorized user signed the message with
-- the specified KMS key and signing algorithm, and the message hasn\'t
-- changed since it was signed. If the signature is verified, the value of
-- the @SignatureValid@ field in the response is @True@. If the signature
-- verification fails, the @Verify@ operation fails with an
-- @KMSInvalidSignatureException@ exception.
--
-- A digital signature is generated by using the private key in an
-- asymmetric KMS key. The signature is verified by using the public key in
-- the same asymmetric KMS key. For information about asymmetric KMS keys,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Asymmetric KMS keys>
-- in the /Key Management Service Developer Guide/.
--
-- To verify a digital signature, you can use the @Verify@ operation.
-- Specify the same asymmetric KMS key, message, and signing algorithm that
-- were used to produce the signature.
--
-- You can also verify the digital signature by using the public key of the
-- KMS key outside of KMS. Use the GetPublicKey operation to download the
-- public key in the asymmetric KMS key and then use the public key to
-- verify the signature outside of KMS. The advantage of using the @Verify@
-- operation is that it is performed within KMS. As a result, it\'s easy to
-- call, the operation is performed within the FIPS boundary, it is logged
-- in CloudTrail, and you can use key policy and IAM policy to determine
-- who is authorized to use the KMS key to verify signatures.
--
-- To verify a signature outside of KMS with an SM2 public key (China
-- Regions only), you must specify the distinguishing ID. By default, KMS
-- uses @1234567812345678@ as the distinguishing ID. For more information,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/asymmetric-key-specs.html#key-spec-sm-offline-verification Offline verification with SM2 key pairs>.
--
-- The KMS key that you use for this operation must be in a compatible key
-- state. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-state.html Key states of KMS keys>
-- in the /Key Management Service Developer Guide/.
--
-- __Cross-account use__: Yes. To perform this operation with a KMS key in
-- a different Amazon Web Services account, specify the key ARN or alias
-- ARN in the value of the @KeyId@ parameter.
--
-- __Required permissions__:
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:Verify>
-- (key policy)
--
-- __Related operations__: Sign
module Amazonka.KMS.Verify
  ( -- * Creating a Request
    Verify (..),
    newVerify,

    -- * Request Lenses
    verify_grantTokens,
    verify_messageType,
    verify_keyId,
    verify_message,
    verify_signature,
    verify_signingAlgorithm,

    -- * Destructuring the Response
    VerifyResponse (..),
    newVerifyResponse,

    -- * Response Lenses
    verifyResponse_keyId,
    verifyResponse_signatureValid,
    verifyResponse_signingAlgorithm,
    verifyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KMS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newVerify' smart constructor.
data Verify = Verify'
  { -- | A list of grant tokens.
    --
    -- Use a grant token when your permission to call this operation comes from
    -- a new grant that has not yet achieved /eventual consistency/. For more
    -- information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
    -- and
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
    -- in the /Key Management Service Developer Guide/.
    Verify -> Maybe [Text]
grantTokens :: Prelude.Maybe [Prelude.Text],
    -- | Tells KMS whether the value of the @Message@ parameter is a message or
    -- message digest. The default value, RAW, indicates a message. To indicate
    -- a message digest, enter @DIGEST@.
    --
    -- Use the @DIGEST@ value only when the value of the @Message@ parameter is
    -- a message digest. If you use the @DIGEST@ value with a raw message, the
    -- security of the verification operation can be compromised.
    Verify -> Maybe MessageType
messageType :: Prelude.Maybe MessageType,
    -- | Identifies the asymmetric KMS key that will be used to verify the
    -- signature. This must be the same KMS key that was used to generate the
    -- signature. If you specify a different KMS key, the signature
    -- verification fails.
    --
    -- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
    -- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
    -- 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@
    --
    -- To get the key ID and key ARN for a KMS key, use ListKeys or
    -- DescribeKey. To get the alias name and alias ARN, use ListAliases.
    Verify -> Text
keyId :: Prelude.Text,
    -- | Specifies the message that was signed. You can submit a raw message of
    -- up to 4096 bytes, or a hash digest of the message. If you submit a
    -- digest, use the @MessageType@ parameter with a value of @DIGEST@.
    --
    -- If the message specified here is different from the message that was
    -- signed, the signature verification fails. A message and its hash digest
    -- are considered to be the same message.
    Verify -> Sensitive Base64
message :: Data.Sensitive Data.Base64,
    -- | The signature that the @Sign@ operation generated.
    Verify -> Base64
signature :: Data.Base64,
    -- | The signing algorithm that was used to sign the message. If you submit a
    -- different algorithm, the signature verification fails.
    Verify -> SigningAlgorithmSpec
signingAlgorithm :: SigningAlgorithmSpec
  }
  deriving (Verify -> Verify -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verify -> Verify -> Bool
$c/= :: Verify -> Verify -> Bool
== :: Verify -> Verify -> Bool
$c== :: Verify -> Verify -> Bool
Prelude.Eq, Int -> Verify -> ShowS
[Verify] -> ShowS
Verify -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verify] -> ShowS
$cshowList :: [Verify] -> ShowS
show :: Verify -> String
$cshow :: Verify -> String
showsPrec :: Int -> Verify -> ShowS
$cshowsPrec :: Int -> Verify -> ShowS
Prelude.Show, forall x. Rep Verify x -> Verify
forall x. Verify -> Rep Verify x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Verify x -> Verify
$cfrom :: forall x. Verify -> Rep Verify x
Prelude.Generic)

-- |
-- Create a value of 'Verify' 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:
--
-- 'grantTokens', 'verify_grantTokens' - A list of grant tokens.
--
-- Use a grant token when your permission to call this operation comes from
-- a new grant that has not yet achieved /eventual consistency/. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
-- in the /Key Management Service Developer Guide/.
--
-- 'messageType', 'verify_messageType' - Tells KMS whether the value of the @Message@ parameter is a message or
-- message digest. The default value, RAW, indicates a message. To indicate
-- a message digest, enter @DIGEST@.
--
-- Use the @DIGEST@ value only when the value of the @Message@ parameter is
-- a message digest. If you use the @DIGEST@ value with a raw message, the
-- security of the verification operation can be compromised.
--
-- 'keyId', 'verify_keyId' - Identifies the asymmetric KMS key that will be used to verify the
-- signature. This must be the same KMS key that was used to generate the
-- signature. If you specify a different KMS key, the signature
-- verification fails.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- 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@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
--
-- 'message', 'verify_message' - Specifies the message that was signed. You can submit a raw message of
-- up to 4096 bytes, or a hash digest of the message. If you submit a
-- digest, use the @MessageType@ parameter with a value of @DIGEST@.
--
-- If the message specified here is different from the message that was
-- signed, the signature verification fails. A message and its hash digest
-- are considered to be the same message.--
-- -- /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.
--
-- 'signature', 'verify_signature' - The signature that the @Sign@ operation generated.--
-- -- /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.
--
-- 'signingAlgorithm', 'verify_signingAlgorithm' - The signing algorithm that was used to sign the message. If you submit a
-- different algorithm, the signature verification fails.
newVerify ::
  -- | 'keyId'
  Prelude.Text ->
  -- | 'message'
  Prelude.ByteString ->
  -- | 'signature'
  Prelude.ByteString ->
  -- | 'signingAlgorithm'
  SigningAlgorithmSpec ->
  Verify
newVerify :: Text -> ByteString -> ByteString -> SigningAlgorithmSpec -> Verify
newVerify
  Text
pKeyId_
  ByteString
pMessage_
  ByteString
pSignature_
  SigningAlgorithmSpec
pSigningAlgorithm_ =
    Verify'
      { $sel:grantTokens:Verify' :: Maybe [Text]
grantTokens = forall a. Maybe a
Prelude.Nothing,
        $sel:messageType:Verify' :: Maybe MessageType
messageType = forall a. Maybe a
Prelude.Nothing,
        $sel:keyId:Verify' :: Text
keyId = Text
pKeyId_,
        $sel:message:Verify' :: Sensitive Base64
message =
          forall a. Iso' (Sensitive a) a
Data._Sensitive
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64
            forall t b. AReview t b -> b -> t
Lens.# ByteString
pMessage_,
        $sel:signature:Verify' :: Base64
signature = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pSignature_,
        $sel:signingAlgorithm:Verify' :: SigningAlgorithmSpec
signingAlgorithm = SigningAlgorithmSpec
pSigningAlgorithm_
      }

-- | A list of grant tokens.
--
-- Use a grant token when your permission to call this operation comes from
-- a new grant that has not yet achieved /eventual consistency/. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
-- in the /Key Management Service Developer Guide/.
verify_grantTokens :: Lens.Lens' Verify (Prelude.Maybe [Prelude.Text])
verify_grantTokens :: Lens' Verify (Maybe [Text])
verify_grantTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {Maybe [Text]
grantTokens :: Maybe [Text]
$sel:grantTokens:Verify' :: Verify -> Maybe [Text]
grantTokens} -> Maybe [Text]
grantTokens) (\s :: Verify
s@Verify' {} Maybe [Text]
a -> Verify
s {$sel:grantTokens:Verify' :: Maybe [Text]
grantTokens = Maybe [Text]
a} :: Verify) 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

-- | Tells KMS whether the value of the @Message@ parameter is a message or
-- message digest. The default value, RAW, indicates a message. To indicate
-- a message digest, enter @DIGEST@.
--
-- Use the @DIGEST@ value only when the value of the @Message@ parameter is
-- a message digest. If you use the @DIGEST@ value with a raw message, the
-- security of the verification operation can be compromised.
verify_messageType :: Lens.Lens' Verify (Prelude.Maybe MessageType)
verify_messageType :: Lens' Verify (Maybe MessageType)
verify_messageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {Maybe MessageType
messageType :: Maybe MessageType
$sel:messageType:Verify' :: Verify -> Maybe MessageType
messageType} -> Maybe MessageType
messageType) (\s :: Verify
s@Verify' {} Maybe MessageType
a -> Verify
s {$sel:messageType:Verify' :: Maybe MessageType
messageType = Maybe MessageType
a} :: Verify)

-- | Identifies the asymmetric KMS key that will be used to verify the
-- signature. This must be the same KMS key that was used to generate the
-- signature. If you specify a different KMS key, the signature
-- verification fails.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- 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@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
verify_keyId :: Lens.Lens' Verify Prelude.Text
verify_keyId :: Lens' Verify Text
verify_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {Text
keyId :: Text
$sel:keyId:Verify' :: Verify -> Text
keyId} -> Text
keyId) (\s :: Verify
s@Verify' {} Text
a -> Verify
s {$sel:keyId:Verify' :: Text
keyId = Text
a} :: Verify)

-- | Specifies the message that was signed. You can submit a raw message of
-- up to 4096 bytes, or a hash digest of the message. If you submit a
-- digest, use the @MessageType@ parameter with a value of @DIGEST@.
--
-- If the message specified here is different from the message that was
-- signed, the signature verification fails. A message and its hash digest
-- are considered to be the same message.--
-- -- /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.
verify_message :: Lens.Lens' Verify Prelude.ByteString
verify_message :: Lens' Verify ByteString
verify_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {Sensitive Base64
message :: Sensitive Base64
$sel:message:Verify' :: Verify -> Sensitive Base64
message} -> Sensitive Base64
message) (\s :: Verify
s@Verify' {} Sensitive Base64
a -> Verify
s {$sel:message:Verify' :: Sensitive Base64
message = Sensitive Base64
a} :: Verify) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The signature that the @Sign@ operation generated.--
-- -- /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.
verify_signature :: Lens.Lens' Verify Prelude.ByteString
verify_signature :: Lens' Verify ByteString
verify_signature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {Base64
signature :: Base64
$sel:signature:Verify' :: Verify -> Base64
signature} -> Base64
signature) (\s :: Verify
s@Verify' {} Base64
a -> Verify
s {$sel:signature:Verify' :: Base64
signature = Base64
a} :: Verify) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The signing algorithm that was used to sign the message. If you submit a
-- different algorithm, the signature verification fails.
verify_signingAlgorithm :: Lens.Lens' Verify SigningAlgorithmSpec
verify_signingAlgorithm :: Lens' Verify SigningAlgorithmSpec
verify_signingAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Verify' {SigningAlgorithmSpec
signingAlgorithm :: SigningAlgorithmSpec
$sel:signingAlgorithm:Verify' :: Verify -> SigningAlgorithmSpec
signingAlgorithm} -> SigningAlgorithmSpec
signingAlgorithm) (\s :: Verify
s@Verify' {} SigningAlgorithmSpec
a -> Verify
s {$sel:signingAlgorithm:Verify' :: SigningAlgorithmSpec
signingAlgorithm = SigningAlgorithmSpec
a} :: Verify)

instance Core.AWSRequest Verify where
  type AWSResponse Verify = VerifyResponse
  request :: (Service -> Service) -> Verify -> Request Verify
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 Verify
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Verify)))
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 Bool
-> Maybe SigningAlgorithmSpec
-> Int
-> VerifyResponse
VerifyResponse'
            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
"KeyId")
            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
"SignatureValid")
            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
"SigningAlgorithm")
            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 Verify where
  hashWithSalt :: Int -> Verify -> Int
hashWithSalt Int
_salt Verify' {Maybe [Text]
Maybe MessageType
Text
Base64
Sensitive Base64
SigningAlgorithmSpec
signingAlgorithm :: SigningAlgorithmSpec
signature :: Base64
message :: Sensitive Base64
keyId :: Text
messageType :: Maybe MessageType
grantTokens :: Maybe [Text]
$sel:signingAlgorithm:Verify' :: Verify -> SigningAlgorithmSpec
$sel:signature:Verify' :: Verify -> Base64
$sel:message:Verify' :: Verify -> Sensitive Base64
$sel:keyId:Verify' :: Verify -> Text
$sel:messageType:Verify' :: Verify -> Maybe MessageType
$sel:grantTokens:Verify' :: Verify -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
grantTokens
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MessageType
messageType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Base64
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
signature
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SigningAlgorithmSpec
signingAlgorithm

instance Prelude.NFData Verify where
  rnf :: Verify -> ()
rnf Verify' {Maybe [Text]
Maybe MessageType
Text
Base64
Sensitive Base64
SigningAlgorithmSpec
signingAlgorithm :: SigningAlgorithmSpec
signature :: Base64
message :: Sensitive Base64
keyId :: Text
messageType :: Maybe MessageType
grantTokens :: Maybe [Text]
$sel:signingAlgorithm:Verify' :: Verify -> SigningAlgorithmSpec
$sel:signature:Verify' :: Verify -> Base64
$sel:message:Verify' :: Verify -> Sensitive Base64
$sel:keyId:Verify' :: Verify -> Text
$sel:messageType:Verify' :: Verify -> Maybe MessageType
$sel:grantTokens:Verify' :: Verify -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
grantTokens
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageType
messageType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Base64
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
signature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SigningAlgorithmSpec
signingAlgorithm

instance Data.ToHeaders Verify where
  toHeaders :: Verify -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"TrentService.Verify" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON Verify where
  toJSON :: Verify -> Value
toJSON Verify' {Maybe [Text]
Maybe MessageType
Text
Base64
Sensitive Base64
SigningAlgorithmSpec
signingAlgorithm :: SigningAlgorithmSpec
signature :: Base64
message :: Sensitive Base64
keyId :: Text
messageType :: Maybe MessageType
grantTokens :: Maybe [Text]
$sel:signingAlgorithm:Verify' :: Verify -> SigningAlgorithmSpec
$sel:signature:Verify' :: Verify -> Base64
$sel:message:Verify' :: Verify -> Sensitive Base64
$sel:keyId:Verify' :: Verify -> Text
$sel:messageType:Verify' :: Verify -> Maybe MessageType
$sel:grantTokens:Verify' :: Verify -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GrantTokens" 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]
grantTokens,
            (Key
"MessageType" 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 MessageType
messageType,
            forall a. a -> Maybe a
Prelude.Just (Key
"KeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Base64
message),
            forall a. a -> Maybe a
Prelude.Just (Key
"Signature" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
signature),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SigningAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SigningAlgorithmSpec
signingAlgorithm)
          ]
      )

instance Data.ToPath Verify where
  toPath :: Verify -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newVerifyResponse' smart constructor.
data VerifyResponse = VerifyResponse'
  { -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
    -- of the asymmetric KMS key that was used to verify the signature.
    VerifyResponse -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text,
    -- | A Boolean value that indicates whether the signature was verified. A
    -- value of @True@ indicates that the @Signature@ was produced by signing
    -- the @Message@ with the specified @KeyID@ and @SigningAlgorithm.@ If the
    -- signature is not verified, the @Verify@ operation fails with a
    -- @KMSInvalidSignatureException@ exception.
    VerifyResponse -> Maybe Bool
signatureValid :: Prelude.Maybe Prelude.Bool,
    -- | The signing algorithm that was used to verify the signature.
    VerifyResponse -> Maybe SigningAlgorithmSpec
signingAlgorithm :: Prelude.Maybe SigningAlgorithmSpec,
    -- | The response's http status code.
    VerifyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (VerifyResponse -> VerifyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifyResponse -> VerifyResponse -> Bool
$c/= :: VerifyResponse -> VerifyResponse -> Bool
== :: VerifyResponse -> VerifyResponse -> Bool
$c== :: VerifyResponse -> VerifyResponse -> Bool
Prelude.Eq, ReadPrec [VerifyResponse]
ReadPrec VerifyResponse
Int -> ReadS VerifyResponse
ReadS [VerifyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VerifyResponse]
$creadListPrec :: ReadPrec [VerifyResponse]
readPrec :: ReadPrec VerifyResponse
$creadPrec :: ReadPrec VerifyResponse
readList :: ReadS [VerifyResponse]
$creadList :: ReadS [VerifyResponse]
readsPrec :: Int -> ReadS VerifyResponse
$creadsPrec :: Int -> ReadS VerifyResponse
Prelude.Read, Int -> VerifyResponse -> ShowS
[VerifyResponse] -> ShowS
VerifyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifyResponse] -> ShowS
$cshowList :: [VerifyResponse] -> ShowS
show :: VerifyResponse -> String
$cshow :: VerifyResponse -> String
showsPrec :: Int -> VerifyResponse -> ShowS
$cshowsPrec :: Int -> VerifyResponse -> ShowS
Prelude.Show, forall x. Rep VerifyResponse x -> VerifyResponse
forall x. VerifyResponse -> Rep VerifyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerifyResponse x -> VerifyResponse
$cfrom :: forall x. VerifyResponse -> Rep VerifyResponse x
Prelude.Generic)

-- |
-- Create a value of 'VerifyResponse' 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:
--
-- 'keyId', 'verifyResponse_keyId' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
-- of the asymmetric KMS key that was used to verify the signature.
--
-- 'signatureValid', 'verifyResponse_signatureValid' - A Boolean value that indicates whether the signature was verified. A
-- value of @True@ indicates that the @Signature@ was produced by signing
-- the @Message@ with the specified @KeyID@ and @SigningAlgorithm.@ If the
-- signature is not verified, the @Verify@ operation fails with a
-- @KMSInvalidSignatureException@ exception.
--
-- 'signingAlgorithm', 'verifyResponse_signingAlgorithm' - The signing algorithm that was used to verify the signature.
--
-- 'httpStatus', 'verifyResponse_httpStatus' - The response's http status code.
newVerifyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  VerifyResponse
newVerifyResponse :: Int -> VerifyResponse
newVerifyResponse Int
pHttpStatus_ =
  VerifyResponse'
    { $sel:keyId:VerifyResponse' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureValid:VerifyResponse' :: Maybe Bool
signatureValid = forall a. Maybe a
Prelude.Nothing,
      $sel:signingAlgorithm:VerifyResponse' :: Maybe SigningAlgorithmSpec
signingAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:VerifyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
-- of the asymmetric KMS key that was used to verify the signature.
verifyResponse_keyId :: Lens.Lens' VerifyResponse (Prelude.Maybe Prelude.Text)
verifyResponse_keyId :: Lens' VerifyResponse (Maybe Text)
verifyResponse_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyResponse' {Maybe Text
keyId :: Maybe Text
$sel:keyId:VerifyResponse' :: VerifyResponse -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: VerifyResponse
s@VerifyResponse' {} Maybe Text
a -> VerifyResponse
s {$sel:keyId:VerifyResponse' :: Maybe Text
keyId = Maybe Text
a} :: VerifyResponse)

-- | A Boolean value that indicates whether the signature was verified. A
-- value of @True@ indicates that the @Signature@ was produced by signing
-- the @Message@ with the specified @KeyID@ and @SigningAlgorithm.@ If the
-- signature is not verified, the @Verify@ operation fails with a
-- @KMSInvalidSignatureException@ exception.
verifyResponse_signatureValid :: Lens.Lens' VerifyResponse (Prelude.Maybe Prelude.Bool)
verifyResponse_signatureValid :: Lens' VerifyResponse (Maybe Bool)
verifyResponse_signatureValid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyResponse' {Maybe Bool
signatureValid :: Maybe Bool
$sel:signatureValid:VerifyResponse' :: VerifyResponse -> Maybe Bool
signatureValid} -> Maybe Bool
signatureValid) (\s :: VerifyResponse
s@VerifyResponse' {} Maybe Bool
a -> VerifyResponse
s {$sel:signatureValid:VerifyResponse' :: Maybe Bool
signatureValid = Maybe Bool
a} :: VerifyResponse)

-- | The signing algorithm that was used to verify the signature.
verifyResponse_signingAlgorithm :: Lens.Lens' VerifyResponse (Prelude.Maybe SigningAlgorithmSpec)
verifyResponse_signingAlgorithm :: Lens' VerifyResponse (Maybe SigningAlgorithmSpec)
verifyResponse_signingAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyResponse' {Maybe SigningAlgorithmSpec
signingAlgorithm :: Maybe SigningAlgorithmSpec
$sel:signingAlgorithm:VerifyResponse' :: VerifyResponse -> Maybe SigningAlgorithmSpec
signingAlgorithm} -> Maybe SigningAlgorithmSpec
signingAlgorithm) (\s :: VerifyResponse
s@VerifyResponse' {} Maybe SigningAlgorithmSpec
a -> VerifyResponse
s {$sel:signingAlgorithm:VerifyResponse' :: Maybe SigningAlgorithmSpec
signingAlgorithm = Maybe SigningAlgorithmSpec
a} :: VerifyResponse)

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

instance Prelude.NFData VerifyResponse where
  rnf :: VerifyResponse -> ()
rnf VerifyResponse' {Int
Maybe Bool
Maybe Text
Maybe SigningAlgorithmSpec
httpStatus :: Int
signingAlgorithm :: Maybe SigningAlgorithmSpec
signatureValid :: Maybe Bool
keyId :: Maybe Text
$sel:httpStatus:VerifyResponse' :: VerifyResponse -> Int
$sel:signingAlgorithm:VerifyResponse' :: VerifyResponse -> Maybe SigningAlgorithmSpec
$sel:signatureValid:VerifyResponse' :: VerifyResponse -> Maybe Bool
$sel:keyId:VerifyResponse' :: VerifyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
signatureValid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningAlgorithmSpec
signingAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus