{-# 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.RevokeSigningProfile
-- 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 profile to REVOKED. This indicates that
-- signatures generated using the signing profile after an effective start
-- date are no longer valid.
module Amazonka.Signer.RevokeSigningProfile
  ( -- * Creating a Request
    RevokeSigningProfile (..),
    newRevokeSigningProfile,

    -- * Request Lenses
    revokeSigningProfile_profileVersion,
    revokeSigningProfile_reason,
    revokeSigningProfile_effectiveTime,
    revokeSigningProfile_profileName,

    -- * Destructuring the Response
    RevokeSigningProfileResponse (..),
    newRevokeSigningProfileResponse,
  )
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:/ 'newRevokeSigningProfile' smart constructor.
data RevokeSigningProfile = RevokeSigningProfile'
  { -- | The version of the signing profile to be revoked.
    RevokeSigningProfile -> Text
profileVersion :: Prelude.Text,
    -- | The reason for revoking a signing profile.
    RevokeSigningProfile -> Text
reason :: Prelude.Text,
    -- | A timestamp for when revocation of a Signing Profile should become
    -- effective. Signatures generated using the signing profile after this
    -- timestamp are not trusted.
    RevokeSigningProfile -> POSIX
effectiveTime :: Data.POSIX,
    -- | The name of the signing profile to be revoked.
    RevokeSigningProfile -> Text
profileName :: Prelude.Text
  }
  deriving (RevokeSigningProfile -> RevokeSigningProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSigningProfile -> RevokeSigningProfile -> Bool
$c/= :: RevokeSigningProfile -> RevokeSigningProfile -> Bool
== :: RevokeSigningProfile -> RevokeSigningProfile -> Bool
$c== :: RevokeSigningProfile -> RevokeSigningProfile -> Bool
Prelude.Eq, ReadPrec [RevokeSigningProfile]
ReadPrec RevokeSigningProfile
Int -> ReadS RevokeSigningProfile
ReadS [RevokeSigningProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeSigningProfile]
$creadListPrec :: ReadPrec [RevokeSigningProfile]
readPrec :: ReadPrec RevokeSigningProfile
$creadPrec :: ReadPrec RevokeSigningProfile
readList :: ReadS [RevokeSigningProfile]
$creadList :: ReadS [RevokeSigningProfile]
readsPrec :: Int -> ReadS RevokeSigningProfile
$creadsPrec :: Int -> ReadS RevokeSigningProfile
Prelude.Read, Int -> RevokeSigningProfile -> ShowS
[RevokeSigningProfile] -> ShowS
RevokeSigningProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSigningProfile] -> ShowS
$cshowList :: [RevokeSigningProfile] -> ShowS
show :: RevokeSigningProfile -> String
$cshow :: RevokeSigningProfile -> String
showsPrec :: Int -> RevokeSigningProfile -> ShowS
$cshowsPrec :: Int -> RevokeSigningProfile -> ShowS
Prelude.Show, forall x. Rep RevokeSigningProfile x -> RevokeSigningProfile
forall x. RevokeSigningProfile -> Rep RevokeSigningProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeSigningProfile x -> RevokeSigningProfile
$cfrom :: forall x. RevokeSigningProfile -> Rep RevokeSigningProfile x
Prelude.Generic)

-- |
-- Create a value of 'RevokeSigningProfile' 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:
--
-- 'profileVersion', 'revokeSigningProfile_profileVersion' - The version of the signing profile to be revoked.
--
-- 'reason', 'revokeSigningProfile_reason' - The reason for revoking a signing profile.
--
-- 'effectiveTime', 'revokeSigningProfile_effectiveTime' - A timestamp for when revocation of a Signing Profile should become
-- effective. Signatures generated using the signing profile after this
-- timestamp are not trusted.
--
-- 'profileName', 'revokeSigningProfile_profileName' - The name of the signing profile to be revoked.
newRevokeSigningProfile ::
  -- | 'profileVersion'
  Prelude.Text ->
  -- | 'reason'
  Prelude.Text ->
  -- | 'effectiveTime'
  Prelude.UTCTime ->
  -- | 'profileName'
  Prelude.Text ->
  RevokeSigningProfile
newRevokeSigningProfile :: Text -> Text -> UTCTime -> Text -> RevokeSigningProfile
newRevokeSigningProfile
  Text
pProfileVersion_
  Text
pReason_
  UTCTime
pEffectiveTime_
  Text
pProfileName_ =
    RevokeSigningProfile'
      { $sel:profileVersion:RevokeSigningProfile' :: Text
profileVersion =
          Text
pProfileVersion_,
        $sel:reason:RevokeSigningProfile' :: Text
reason = Text
pReason_,
        $sel:effectiveTime:RevokeSigningProfile' :: POSIX
effectiveTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEffectiveTime_,
        $sel:profileName:RevokeSigningProfile' :: Text
profileName = Text
pProfileName_
      }

-- | The version of the signing profile to be revoked.
revokeSigningProfile_profileVersion :: Lens.Lens' RevokeSigningProfile Prelude.Text
revokeSigningProfile_profileVersion :: Lens' RevokeSigningProfile Text
revokeSigningProfile_profileVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSigningProfile' {Text
profileVersion :: Text
$sel:profileVersion:RevokeSigningProfile' :: RevokeSigningProfile -> Text
profileVersion} -> Text
profileVersion) (\s :: RevokeSigningProfile
s@RevokeSigningProfile' {} Text
a -> RevokeSigningProfile
s {$sel:profileVersion:RevokeSigningProfile' :: Text
profileVersion = Text
a} :: RevokeSigningProfile)

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

-- | A timestamp for when revocation of a Signing Profile should become
-- effective. Signatures generated using the signing profile after this
-- timestamp are not trusted.
revokeSigningProfile_effectiveTime :: Lens.Lens' RevokeSigningProfile Prelude.UTCTime
revokeSigningProfile_effectiveTime :: Lens' RevokeSigningProfile UTCTime
revokeSigningProfile_effectiveTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSigningProfile' {POSIX
effectiveTime :: POSIX
$sel:effectiveTime:RevokeSigningProfile' :: RevokeSigningProfile -> POSIX
effectiveTime} -> POSIX
effectiveTime) (\s :: RevokeSigningProfile
s@RevokeSigningProfile' {} POSIX
a -> RevokeSigningProfile
s {$sel:effectiveTime:RevokeSigningProfile' :: POSIX
effectiveTime = POSIX
a} :: RevokeSigningProfile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the signing profile to be revoked.
revokeSigningProfile_profileName :: Lens.Lens' RevokeSigningProfile Prelude.Text
revokeSigningProfile_profileName :: Lens' RevokeSigningProfile Text
revokeSigningProfile_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSigningProfile' {Text
profileName :: Text
$sel:profileName:RevokeSigningProfile' :: RevokeSigningProfile -> Text
profileName} -> Text
profileName) (\s :: RevokeSigningProfile
s@RevokeSigningProfile' {} Text
a -> RevokeSigningProfile
s {$sel:profileName:RevokeSigningProfile' :: Text
profileName = Text
a} :: RevokeSigningProfile)

instance Core.AWSRequest RevokeSigningProfile where
  type
    AWSResponse RevokeSigningProfile =
      RevokeSigningProfileResponse
  request :: (Service -> Service)
-> RevokeSigningProfile -> Request RevokeSigningProfile
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 RevokeSigningProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RevokeSigningProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RevokeSigningProfileResponse
RevokeSigningProfileResponse'

instance Prelude.Hashable RevokeSigningProfile where
  hashWithSalt :: Int -> RevokeSigningProfile -> Int
hashWithSalt Int
_salt RevokeSigningProfile' {Text
POSIX
profileName :: Text
effectiveTime :: POSIX
reason :: Text
profileVersion :: Text
$sel:profileName:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:effectiveTime:RevokeSigningProfile' :: RevokeSigningProfile -> POSIX
$sel:reason:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:profileVersion:RevokeSigningProfile' :: RevokeSigningProfile -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
effectiveTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName

instance Prelude.NFData RevokeSigningProfile where
  rnf :: RevokeSigningProfile -> ()
rnf RevokeSigningProfile' {Text
POSIX
profileName :: Text
effectiveTime :: POSIX
reason :: Text
profileVersion :: Text
$sel:profileName:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:effectiveTime:RevokeSigningProfile' :: RevokeSigningProfile -> POSIX
$sel:reason:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:profileVersion:RevokeSigningProfile' :: RevokeSigningProfile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
profileVersion
      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 POSIX
effectiveTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profileName

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

instance Data.ToPath RevokeSigningProfile where
  toPath :: RevokeSigningProfile -> ByteString
toPath RevokeSigningProfile' {Text
POSIX
profileName :: Text
effectiveTime :: POSIX
reason :: Text
profileVersion :: Text
$sel:profileName:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:effectiveTime:RevokeSigningProfile' :: RevokeSigningProfile -> POSIX
$sel:reason:RevokeSigningProfile' :: RevokeSigningProfile -> Text
$sel:profileVersion:RevokeSigningProfile' :: RevokeSigningProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/signing-profiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
profileName,
        ByteString
"/revoke"
      ]

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

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

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

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