{-# 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.Signer.RevokeSignature
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the state of a signing job to REVOKED. This indicates that the
-- signature is no longer valid.
module Amazonka.Signer.RevokeSignature
  ( -- * Creating a Request
    RevokeSignature (..),
    newRevokeSignature,

    -- * Request Lenses
    revokeSignature_jobOwner,
    revokeSignature_reason,
    revokeSignature_jobId,

    -- * Destructuring the Response
    RevokeSignatureResponse (..),
    newRevokeSignatureResponse,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Signer.Types

-- | /See:/ 'newRevokeSignature' smart constructor.
data RevokeSignature = RevokeSignature'
  { -- | AWS account ID of the job owner.
    RevokeSignature -> Maybe Text
jobOwner :: Prelude.Maybe Prelude.Text,
    -- | The reason for revoking the signing job.
    RevokeSignature -> Text
reason :: Prelude.Text,
    -- | ID of the signing job to be revoked.
    RevokeSignature -> Text
jobId :: Prelude.Text
  }
  deriving (RevokeSignature -> RevokeSignature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSignature -> RevokeSignature -> Bool
$c/= :: RevokeSignature -> RevokeSignature -> Bool
== :: RevokeSignature -> RevokeSignature -> Bool
$c== :: RevokeSignature -> RevokeSignature -> Bool
Prelude.Eq, ReadPrec [RevokeSignature]
ReadPrec RevokeSignature
Int -> ReadS RevokeSignature
ReadS [RevokeSignature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeSignature]
$creadListPrec :: ReadPrec [RevokeSignature]
readPrec :: ReadPrec RevokeSignature
$creadPrec :: ReadPrec RevokeSignature
readList :: ReadS [RevokeSignature]
$creadList :: ReadS [RevokeSignature]
readsPrec :: Int -> ReadS RevokeSignature
$creadsPrec :: Int -> ReadS RevokeSignature
Prelude.Read, Int -> RevokeSignature -> ShowS
[RevokeSignature] -> ShowS
RevokeSignature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSignature] -> ShowS
$cshowList :: [RevokeSignature] -> ShowS
show :: RevokeSignature -> String
$cshow :: RevokeSignature -> String
showsPrec :: Int -> RevokeSignature -> ShowS
$cshowsPrec :: Int -> RevokeSignature -> ShowS
Prelude.Show, forall x. Rep RevokeSignature x -> RevokeSignature
forall x. RevokeSignature -> Rep RevokeSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeSignature x -> RevokeSignature
$cfrom :: forall x. RevokeSignature -> Rep RevokeSignature x
Prelude.Generic)

-- |
-- Create a value of 'RevokeSignature' 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:
--
-- 'jobOwner', 'revokeSignature_jobOwner' - AWS account ID of the job owner.
--
-- 'reason', 'revokeSignature_reason' - The reason for revoking the signing job.
--
-- 'jobId', 'revokeSignature_jobId' - ID of the signing job to be revoked.
newRevokeSignature ::
  -- | 'reason'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  RevokeSignature
newRevokeSignature :: Text -> Text -> RevokeSignature
newRevokeSignature Text
pReason_ Text
pJobId_ =
  RevokeSignature'
    { $sel:jobOwner:RevokeSignature' :: Maybe Text
jobOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:RevokeSignature' :: Text
reason = Text
pReason_,
      $sel:jobId:RevokeSignature' :: Text
jobId = Text
pJobId_
    }

-- | AWS account ID of the job owner.
revokeSignature_jobOwner :: Lens.Lens' RevokeSignature (Prelude.Maybe Prelude.Text)
revokeSignature_jobOwner :: Lens' RevokeSignature (Maybe Text)
revokeSignature_jobOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSignature' {Maybe Text
jobOwner :: Maybe Text
$sel:jobOwner:RevokeSignature' :: RevokeSignature -> Maybe Text
jobOwner} -> Maybe Text
jobOwner) (\s :: RevokeSignature
s@RevokeSignature' {} Maybe Text
a -> RevokeSignature
s {$sel:jobOwner:RevokeSignature' :: Maybe Text
jobOwner = Maybe Text
a} :: RevokeSignature)

-- | The reason for revoking the signing job.
revokeSignature_reason :: Lens.Lens' RevokeSignature Prelude.Text
revokeSignature_reason :: Lens' RevokeSignature Text
revokeSignature_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSignature' {Text
reason :: Text
$sel:reason:RevokeSignature' :: RevokeSignature -> Text
reason} -> Text
reason) (\s :: RevokeSignature
s@RevokeSignature' {} Text
a -> RevokeSignature
s {$sel:reason:RevokeSignature' :: Text
reason = Text
a} :: RevokeSignature)

-- | ID of the signing job to be revoked.
revokeSignature_jobId :: Lens.Lens' RevokeSignature Prelude.Text
revokeSignature_jobId :: Lens' RevokeSignature Text
revokeSignature_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSignature' {Text
jobId :: Text
$sel:jobId:RevokeSignature' :: RevokeSignature -> Text
jobId} -> Text
jobId) (\s :: RevokeSignature
s@RevokeSignature' {} Text
a -> RevokeSignature
s {$sel:jobId:RevokeSignature' :: Text
jobId = Text
a} :: RevokeSignature)

instance Core.AWSRequest RevokeSignature where
  type
    AWSResponse RevokeSignature =
      RevokeSignatureResponse
  request :: (Service -> Service) -> RevokeSignature -> Request RevokeSignature
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RevokeSignature
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RevokeSignature)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RevokeSignatureResponse
RevokeSignatureResponse'

instance Prelude.Hashable RevokeSignature where
  hashWithSalt :: Int -> RevokeSignature -> Int
hashWithSalt Int
_salt RevokeSignature' {Maybe Text
Text
jobId :: Text
reason :: Text
jobOwner :: Maybe Text
$sel:jobId:RevokeSignature' :: RevokeSignature -> Text
$sel:reason:RevokeSignature' :: RevokeSignature -> Text
$sel:jobOwner:RevokeSignature' :: RevokeSignature -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData RevokeSignature where
  rnf :: RevokeSignature -> ()
rnf RevokeSignature' {Maybe Text
Text
jobId :: Text
reason :: Text
jobOwner :: Maybe Text
$sel:jobId:RevokeSignature' :: RevokeSignature -> Text
$sel:reason:RevokeSignature' :: RevokeSignature -> Text
$sel:jobOwner:RevokeSignature' :: RevokeSignature -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders RevokeSignature where
  toHeaders :: RevokeSignature -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RevokeSignature where
  toJSON :: RevokeSignature -> Value
toJSON RevokeSignature' {Maybe Text
Text
jobId :: Text
reason :: Text
jobOwner :: Maybe Text
$sel:jobId:RevokeSignature' :: RevokeSignature -> Text
$sel:reason:RevokeSignature' :: RevokeSignature -> Text
$sel:jobOwner:RevokeSignature' :: RevokeSignature -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"jobOwner" 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
jobOwner,
            forall a. a -> Maybe a
Prelude.Just (Key
"reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reason)
          ]
      )

instance Data.ToPath RevokeSignature where
  toPath :: RevokeSignature -> ByteString
toPath RevokeSignature' {Maybe Text
Text
jobId :: Text
reason :: Text
jobOwner :: Maybe Text
$sel:jobId:RevokeSignature' :: RevokeSignature -> Text
$sel:reason:RevokeSignature' :: RevokeSignature -> Text
$sel:jobOwner:RevokeSignature' :: RevokeSignature -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/signing-jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId, ByteString
"/revoke"]

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

-- | /See:/ 'newRevokeSignatureResponse' smart constructor.
data RevokeSignatureResponse = RevokeSignatureResponse'
  {
  }
  deriving (RevokeSignatureResponse -> RevokeSignatureResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSignatureResponse -> RevokeSignatureResponse -> Bool
$c/= :: RevokeSignatureResponse -> RevokeSignatureResponse -> Bool
== :: RevokeSignatureResponse -> RevokeSignatureResponse -> Bool
$c== :: RevokeSignatureResponse -> RevokeSignatureResponse -> Bool
Prelude.Eq, ReadPrec [RevokeSignatureResponse]
ReadPrec RevokeSignatureResponse
Int -> ReadS RevokeSignatureResponse
ReadS [RevokeSignatureResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeSignatureResponse]
$creadListPrec :: ReadPrec [RevokeSignatureResponse]
readPrec :: ReadPrec RevokeSignatureResponse
$creadPrec :: ReadPrec RevokeSignatureResponse
readList :: ReadS [RevokeSignatureResponse]
$creadList :: ReadS [RevokeSignatureResponse]
readsPrec :: Int -> ReadS RevokeSignatureResponse
$creadsPrec :: Int -> ReadS RevokeSignatureResponse
Prelude.Read, Int -> RevokeSignatureResponse -> ShowS
[RevokeSignatureResponse] -> ShowS
RevokeSignatureResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSignatureResponse] -> ShowS
$cshowList :: [RevokeSignatureResponse] -> ShowS
show :: RevokeSignatureResponse -> String
$cshow :: RevokeSignatureResponse -> String
showsPrec :: Int -> RevokeSignatureResponse -> ShowS
$cshowsPrec :: Int -> RevokeSignatureResponse -> ShowS
Prelude.Show, forall x. Rep RevokeSignatureResponse x -> RevokeSignatureResponse
forall x. RevokeSignatureResponse -> Rep RevokeSignatureResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeSignatureResponse x -> RevokeSignatureResponse
$cfrom :: forall x. RevokeSignatureResponse -> Rep RevokeSignatureResponse x
Prelude.Generic)

-- |
-- Create a value of 'RevokeSignatureResponse' 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.
newRevokeSignatureResponse ::
  RevokeSignatureResponse
newRevokeSignatureResponse :: RevokeSignatureResponse
newRevokeSignatureResponse = RevokeSignatureResponse
RevokeSignatureResponse'

instance Prelude.NFData RevokeSignatureResponse where
  rnf :: RevokeSignatureResponse -> ()
rnf RevokeSignatureResponse
_ = ()