{-# 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.GetSigningProfile
-- 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 on a specific signing profile.
module Amazonka.Signer.GetSigningProfile
  ( -- * Creating a Request
    GetSigningProfile (..),
    newGetSigningProfile,

    -- * Request Lenses
    getSigningProfile_profileOwner,
    getSigningProfile_profileName,

    -- * Destructuring the Response
    GetSigningProfileResponse (..),
    newGetSigningProfileResponse,

    -- * Response Lenses
    getSigningProfileResponse_arn,
    getSigningProfileResponse_overrides,
    getSigningProfileResponse_platformDisplayName,
    getSigningProfileResponse_platformId,
    getSigningProfileResponse_profileName,
    getSigningProfileResponse_profileVersion,
    getSigningProfileResponse_profileVersionArn,
    getSigningProfileResponse_revocationRecord,
    getSigningProfileResponse_signatureValidityPeriod,
    getSigningProfileResponse_signingMaterial,
    getSigningProfileResponse_signingParameters,
    getSigningProfileResponse_status,
    getSigningProfileResponse_statusReason,
    getSigningProfileResponse_tags,
    getSigningProfileResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Signer.Types

-- | /See:/ 'newGetSigningProfile' smart constructor.
data GetSigningProfile = GetSigningProfile'
  { -- | The AWS account ID of the profile owner.
    GetSigningProfile -> Maybe Text
profileOwner :: Prelude.Maybe Prelude.Text,
    -- | The name of the target signing profile.
    GetSigningProfile -> Text
profileName :: Prelude.Text
  }
  deriving (GetSigningProfile -> GetSigningProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSigningProfile -> GetSigningProfile -> Bool
$c/= :: GetSigningProfile -> GetSigningProfile -> Bool
== :: GetSigningProfile -> GetSigningProfile -> Bool
$c== :: GetSigningProfile -> GetSigningProfile -> Bool
Prelude.Eq, ReadPrec [GetSigningProfile]
ReadPrec GetSigningProfile
Int -> ReadS GetSigningProfile
ReadS [GetSigningProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSigningProfile]
$creadListPrec :: ReadPrec [GetSigningProfile]
readPrec :: ReadPrec GetSigningProfile
$creadPrec :: ReadPrec GetSigningProfile
readList :: ReadS [GetSigningProfile]
$creadList :: ReadS [GetSigningProfile]
readsPrec :: Int -> ReadS GetSigningProfile
$creadsPrec :: Int -> ReadS GetSigningProfile
Prelude.Read, Int -> GetSigningProfile -> ShowS
[GetSigningProfile] -> ShowS
GetSigningProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSigningProfile] -> ShowS
$cshowList :: [GetSigningProfile] -> ShowS
show :: GetSigningProfile -> String
$cshow :: GetSigningProfile -> String
showsPrec :: Int -> GetSigningProfile -> ShowS
$cshowsPrec :: Int -> GetSigningProfile -> ShowS
Prelude.Show, forall x. Rep GetSigningProfile x -> GetSigningProfile
forall x. GetSigningProfile -> Rep GetSigningProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSigningProfile x -> GetSigningProfile
$cfrom :: forall x. GetSigningProfile -> Rep GetSigningProfile x
Prelude.Generic)

-- |
-- Create a value of 'GetSigningProfile' 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:
--
-- 'profileOwner', 'getSigningProfile_profileOwner' - The AWS account ID of the profile owner.
--
-- 'profileName', 'getSigningProfile_profileName' - The name of the target signing profile.
newGetSigningProfile ::
  -- | 'profileName'
  Prelude.Text ->
  GetSigningProfile
newGetSigningProfile :: Text -> GetSigningProfile
newGetSigningProfile Text
pProfileName_ =
  GetSigningProfile'
    { $sel:profileOwner:GetSigningProfile' :: Maybe Text
profileOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:profileName:GetSigningProfile' :: Text
profileName = Text
pProfileName_
    }

-- | The AWS account ID of the profile owner.
getSigningProfile_profileOwner :: Lens.Lens' GetSigningProfile (Prelude.Maybe Prelude.Text)
getSigningProfile_profileOwner :: Lens' GetSigningProfile (Maybe Text)
getSigningProfile_profileOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfile' {Maybe Text
profileOwner :: Maybe Text
$sel:profileOwner:GetSigningProfile' :: GetSigningProfile -> Maybe Text
profileOwner} -> Maybe Text
profileOwner) (\s :: GetSigningProfile
s@GetSigningProfile' {} Maybe Text
a -> GetSigningProfile
s {$sel:profileOwner:GetSigningProfile' :: Maybe Text
profileOwner = Maybe Text
a} :: GetSigningProfile)

-- | The name of the target signing profile.
getSigningProfile_profileName :: Lens.Lens' GetSigningProfile Prelude.Text
getSigningProfile_profileName :: Lens' GetSigningProfile Text
getSigningProfile_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfile' {Text
profileName :: Text
$sel:profileName:GetSigningProfile' :: GetSigningProfile -> Text
profileName} -> Text
profileName) (\s :: GetSigningProfile
s@GetSigningProfile' {} Text
a -> GetSigningProfile
s {$sel:profileName:GetSigningProfile' :: Text
profileName = Text
a} :: GetSigningProfile)

instance Core.AWSRequest GetSigningProfile where
  type
    AWSResponse GetSigningProfile =
      GetSigningProfileResponse
  request :: (Service -> Service)
-> GetSigningProfile -> Request GetSigningProfile
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 GetSigningProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSigningProfile)))
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 SigningPlatformOverrides
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe SigningProfileRevocationRecord
-> Maybe SignatureValidityPeriod
-> Maybe SigningMaterial
-> Maybe (HashMap Text Text)
-> Maybe SigningProfileStatus
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> GetSigningProfileResponse
GetSigningProfileResponse'
            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
"overrides")
            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
"platformDisplayName")
            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
"platformId")
            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
"profileName")
            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
"profileVersion")
            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
"profileVersionArn")
            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
"revocationRecord")
            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
"signatureValidityPeriod")
            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
"signingMaterial")
            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
"signingParameters"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"status")
            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
"statusReason")
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 GetSigningProfile where
  hashWithSalt :: Int -> GetSigningProfile -> Int
hashWithSalt Int
_salt GetSigningProfile' {Maybe Text
Text
profileName :: Text
profileOwner :: Maybe Text
$sel:profileName:GetSigningProfile' :: GetSigningProfile -> Text
$sel:profileOwner:GetSigningProfile' :: GetSigningProfile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
profileOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName

instance Prelude.NFData GetSigningProfile where
  rnf :: GetSigningProfile -> ()
rnf GetSigningProfile' {Maybe Text
Text
profileName :: Text
profileOwner :: Maybe Text
$sel:profileName:GetSigningProfile' :: GetSigningProfile -> Text
$sel:profileOwner:GetSigningProfile' :: GetSigningProfile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profileName

instance Data.ToHeaders GetSigningProfile where
  toHeaders :: GetSigningProfile -> 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.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetSigningProfile where
  toPath :: GetSigningProfile -> ByteString
toPath GetSigningProfile' {Maybe Text
Text
profileName :: Text
profileOwner :: Maybe Text
$sel:profileName:GetSigningProfile' :: GetSigningProfile -> Text
$sel:profileOwner:GetSigningProfile' :: GetSigningProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/signing-profiles/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
profileName]

instance Data.ToQuery GetSigningProfile where
  toQuery :: GetSigningProfile -> QueryString
toQuery GetSigningProfile' {Maybe Text
Text
profileName :: Text
profileOwner :: Maybe Text
$sel:profileName:GetSigningProfile' :: GetSigningProfile -> Text
$sel:profileOwner:GetSigningProfile' :: GetSigningProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"profileOwner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
profileOwner]

-- | /See:/ 'newGetSigningProfileResponse' smart constructor.
data GetSigningProfileResponse = GetSigningProfileResponse'
  { -- | The Amazon Resource Name (ARN) for the signing profile.
    GetSigningProfileResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A list of overrides applied by the target signing profile for signing
    -- operations.
    GetSigningProfileResponse -> Maybe SigningPlatformOverrides
overrides :: Prelude.Maybe SigningPlatformOverrides,
    -- | A human-readable name for the signing platform associated with the
    -- signing profile.
    GetSigningProfileResponse -> Maybe Text
platformDisplayName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the platform that is used by the target signing profile.
    GetSigningProfileResponse -> Maybe Text
platformId :: Prelude.Maybe Prelude.Text,
    -- | The name of the target signing profile.
    GetSigningProfileResponse -> Maybe Text
profileName :: Prelude.Maybe Prelude.Text,
    -- | The current version of the signing profile.
    GetSigningProfileResponse -> Maybe Text
profileVersion :: Prelude.Maybe Prelude.Text,
    -- | The signing profile ARN, including the profile version.
    GetSigningProfileResponse -> Maybe Text
profileVersionArn :: Prelude.Maybe Prelude.Text,
    GetSigningProfileResponse -> Maybe SigningProfileRevocationRecord
revocationRecord :: Prelude.Maybe SigningProfileRevocationRecord,
    GetSigningProfileResponse -> Maybe SignatureValidityPeriod
signatureValidityPeriod :: Prelude.Maybe SignatureValidityPeriod,
    -- | The ARN of the certificate that the target profile uses for signing
    -- operations.
    GetSigningProfileResponse -> Maybe SigningMaterial
signingMaterial :: Prelude.Maybe SigningMaterial,
    -- | A map of key-value pairs for signing operations that is attached to the
    -- target signing profile.
    GetSigningProfileResponse -> Maybe (HashMap Text Text)
signingParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The status of the target signing profile.
    GetSigningProfileResponse -> Maybe SigningProfileStatus
status :: Prelude.Maybe SigningProfileStatus,
    -- | Reason for the status of the target signing profile.
    GetSigningProfileResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | A list of tags associated with the signing profile.
    GetSigningProfileResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetSigningProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSigningProfileResponse -> GetSigningProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSigningProfileResponse -> GetSigningProfileResponse -> Bool
$c/= :: GetSigningProfileResponse -> GetSigningProfileResponse -> Bool
== :: GetSigningProfileResponse -> GetSigningProfileResponse -> Bool
$c== :: GetSigningProfileResponse -> GetSigningProfileResponse -> Bool
Prelude.Eq, ReadPrec [GetSigningProfileResponse]
ReadPrec GetSigningProfileResponse
Int -> ReadS GetSigningProfileResponse
ReadS [GetSigningProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSigningProfileResponse]
$creadListPrec :: ReadPrec [GetSigningProfileResponse]
readPrec :: ReadPrec GetSigningProfileResponse
$creadPrec :: ReadPrec GetSigningProfileResponse
readList :: ReadS [GetSigningProfileResponse]
$creadList :: ReadS [GetSigningProfileResponse]
readsPrec :: Int -> ReadS GetSigningProfileResponse
$creadsPrec :: Int -> ReadS GetSigningProfileResponse
Prelude.Read, Int -> GetSigningProfileResponse -> ShowS
[GetSigningProfileResponse] -> ShowS
GetSigningProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSigningProfileResponse] -> ShowS
$cshowList :: [GetSigningProfileResponse] -> ShowS
show :: GetSigningProfileResponse -> String
$cshow :: GetSigningProfileResponse -> String
showsPrec :: Int -> GetSigningProfileResponse -> ShowS
$cshowsPrec :: Int -> GetSigningProfileResponse -> ShowS
Prelude.Show, forall x.
Rep GetSigningProfileResponse x -> GetSigningProfileResponse
forall x.
GetSigningProfileResponse -> Rep GetSigningProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSigningProfileResponse x -> GetSigningProfileResponse
$cfrom :: forall x.
GetSigningProfileResponse -> Rep GetSigningProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSigningProfileResponse' 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', 'getSigningProfileResponse_arn' - The Amazon Resource Name (ARN) for the signing profile.
--
-- 'overrides', 'getSigningProfileResponse_overrides' - A list of overrides applied by the target signing profile for signing
-- operations.
--
-- 'platformDisplayName', 'getSigningProfileResponse_platformDisplayName' - A human-readable name for the signing platform associated with the
-- signing profile.
--
-- 'platformId', 'getSigningProfileResponse_platformId' - The ID of the platform that is used by the target signing profile.
--
-- 'profileName', 'getSigningProfileResponse_profileName' - The name of the target signing profile.
--
-- 'profileVersion', 'getSigningProfileResponse_profileVersion' - The current version of the signing profile.
--
-- 'profileVersionArn', 'getSigningProfileResponse_profileVersionArn' - The signing profile ARN, including the profile version.
--
-- 'revocationRecord', 'getSigningProfileResponse_revocationRecord' - Undocumented member.
--
-- 'signatureValidityPeriod', 'getSigningProfileResponse_signatureValidityPeriod' - Undocumented member.
--
-- 'signingMaterial', 'getSigningProfileResponse_signingMaterial' - The ARN of the certificate that the target profile uses for signing
-- operations.
--
-- 'signingParameters', 'getSigningProfileResponse_signingParameters' - A map of key-value pairs for signing operations that is attached to the
-- target signing profile.
--
-- 'status', 'getSigningProfileResponse_status' - The status of the target signing profile.
--
-- 'statusReason', 'getSigningProfileResponse_statusReason' - Reason for the status of the target signing profile.
--
-- 'tags', 'getSigningProfileResponse_tags' - A list of tags associated with the signing profile.
--
-- 'httpStatus', 'getSigningProfileResponse_httpStatus' - The response's http status code.
newGetSigningProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSigningProfileResponse
newGetSigningProfileResponse :: Int -> GetSigningProfileResponse
newGetSigningProfileResponse Int
pHttpStatus_ =
  GetSigningProfileResponse'
    { $sel:arn:GetSigningProfileResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:overrides:GetSigningProfileResponse' :: Maybe SigningPlatformOverrides
overrides = forall a. Maybe a
Prelude.Nothing,
      $sel:platformDisplayName:GetSigningProfileResponse' :: Maybe Text
platformDisplayName = forall a. Maybe a
Prelude.Nothing,
      $sel:platformId:GetSigningProfileResponse' :: Maybe Text
platformId = forall a. Maybe a
Prelude.Nothing,
      $sel:profileName:GetSigningProfileResponse' :: Maybe Text
profileName = forall a. Maybe a
Prelude.Nothing,
      $sel:profileVersion:GetSigningProfileResponse' :: Maybe Text
profileVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:profileVersionArn:GetSigningProfileResponse' :: Maybe Text
profileVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:revocationRecord:GetSigningProfileResponse' :: Maybe SigningProfileRevocationRecord
revocationRecord = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureValidityPeriod:GetSigningProfileResponse' :: Maybe SignatureValidityPeriod
signatureValidityPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:signingMaterial:GetSigningProfileResponse' :: Maybe SigningMaterial
signingMaterial = forall a. Maybe a
Prelude.Nothing,
      $sel:signingParameters:GetSigningProfileResponse' :: Maybe (HashMap Text Text)
signingParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetSigningProfileResponse' :: Maybe SigningProfileStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusReason:GetSigningProfileResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetSigningProfileResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSigningProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A list of overrides applied by the target signing profile for signing
-- operations.
getSigningProfileResponse_overrides :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe SigningPlatformOverrides)
getSigningProfileResponse_overrides :: Lens' GetSigningProfileResponse (Maybe SigningPlatformOverrides)
getSigningProfileResponse_overrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe SigningPlatformOverrides
overrides :: Maybe SigningPlatformOverrides
$sel:overrides:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningPlatformOverrides
overrides} -> Maybe SigningPlatformOverrides
overrides) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe SigningPlatformOverrides
a -> GetSigningProfileResponse
s {$sel:overrides:GetSigningProfileResponse' :: Maybe SigningPlatformOverrides
overrides = Maybe SigningPlatformOverrides
a} :: GetSigningProfileResponse)

-- | A human-readable name for the signing platform associated with the
-- signing profile.
getSigningProfileResponse_platformDisplayName :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_platformDisplayName :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_platformDisplayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
platformDisplayName :: Maybe Text
$sel:platformDisplayName:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
platformDisplayName} -> Maybe Text
platformDisplayName) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:platformDisplayName:GetSigningProfileResponse' :: Maybe Text
platformDisplayName = Maybe Text
a} :: GetSigningProfileResponse)

-- | The ID of the platform that is used by the target signing profile.
getSigningProfileResponse_platformId :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_platformId :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
platformId :: Maybe Text
$sel:platformId:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
platformId} -> Maybe Text
platformId) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:platformId:GetSigningProfileResponse' :: Maybe Text
platformId = Maybe Text
a} :: GetSigningProfileResponse)

-- | The name of the target signing profile.
getSigningProfileResponse_profileName :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_profileName :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
profileName :: Maybe Text
$sel:profileName:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
profileName} -> Maybe Text
profileName) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:profileName:GetSigningProfileResponse' :: Maybe Text
profileName = Maybe Text
a} :: GetSigningProfileResponse)

-- | The current version of the signing profile.
getSigningProfileResponse_profileVersion :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_profileVersion :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_profileVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
profileVersion :: Maybe Text
$sel:profileVersion:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
profileVersion} -> Maybe Text
profileVersion) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:profileVersion:GetSigningProfileResponse' :: Maybe Text
profileVersion = Maybe Text
a} :: GetSigningProfileResponse)

-- | The signing profile ARN, including the profile version.
getSigningProfileResponse_profileVersionArn :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_profileVersionArn :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_profileVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
profileVersionArn :: Maybe Text
$sel:profileVersionArn:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
profileVersionArn} -> Maybe Text
profileVersionArn) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:profileVersionArn:GetSigningProfileResponse' :: Maybe Text
profileVersionArn = Maybe Text
a} :: GetSigningProfileResponse)

-- | Undocumented member.
getSigningProfileResponse_revocationRecord :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe SigningProfileRevocationRecord)
getSigningProfileResponse_revocationRecord :: Lens'
  GetSigningProfileResponse (Maybe SigningProfileRevocationRecord)
getSigningProfileResponse_revocationRecord = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe SigningProfileRevocationRecord
revocationRecord :: Maybe SigningProfileRevocationRecord
$sel:revocationRecord:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningProfileRevocationRecord
revocationRecord} -> Maybe SigningProfileRevocationRecord
revocationRecord) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe SigningProfileRevocationRecord
a -> GetSigningProfileResponse
s {$sel:revocationRecord:GetSigningProfileResponse' :: Maybe SigningProfileRevocationRecord
revocationRecord = Maybe SigningProfileRevocationRecord
a} :: GetSigningProfileResponse)

-- | Undocumented member.
getSigningProfileResponse_signatureValidityPeriod :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe SignatureValidityPeriod)
getSigningProfileResponse_signatureValidityPeriod :: Lens' GetSigningProfileResponse (Maybe SignatureValidityPeriod)
getSigningProfileResponse_signatureValidityPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe SignatureValidityPeriod
signatureValidityPeriod :: Maybe SignatureValidityPeriod
$sel:signatureValidityPeriod:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SignatureValidityPeriod
signatureValidityPeriod} -> Maybe SignatureValidityPeriod
signatureValidityPeriod) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe SignatureValidityPeriod
a -> GetSigningProfileResponse
s {$sel:signatureValidityPeriod:GetSigningProfileResponse' :: Maybe SignatureValidityPeriod
signatureValidityPeriod = Maybe SignatureValidityPeriod
a} :: GetSigningProfileResponse)

-- | The ARN of the certificate that the target profile uses for signing
-- operations.
getSigningProfileResponse_signingMaterial :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe SigningMaterial)
getSigningProfileResponse_signingMaterial :: Lens' GetSigningProfileResponse (Maybe SigningMaterial)
getSigningProfileResponse_signingMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe SigningMaterial
signingMaterial :: Maybe SigningMaterial
$sel:signingMaterial:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningMaterial
signingMaterial} -> Maybe SigningMaterial
signingMaterial) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe SigningMaterial
a -> GetSigningProfileResponse
s {$sel:signingMaterial:GetSigningProfileResponse' :: Maybe SigningMaterial
signingMaterial = Maybe SigningMaterial
a} :: GetSigningProfileResponse)

-- | A map of key-value pairs for signing operations that is attached to the
-- target signing profile.
getSigningProfileResponse_signingParameters :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getSigningProfileResponse_signingParameters :: Lens' GetSigningProfileResponse (Maybe (HashMap Text Text))
getSigningProfileResponse_signingParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
$sel:signingParameters:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe (HashMap Text Text)
signingParameters} -> Maybe (HashMap Text Text)
signingParameters) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe (HashMap Text Text)
a -> GetSigningProfileResponse
s {$sel:signingParameters:GetSigningProfileResponse' :: Maybe (HashMap Text Text)
signingParameters = Maybe (HashMap Text Text)
a} :: GetSigningProfileResponse) 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

-- | The status of the target signing profile.
getSigningProfileResponse_status :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe SigningProfileStatus)
getSigningProfileResponse_status :: Lens' GetSigningProfileResponse (Maybe SigningProfileStatus)
getSigningProfileResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe SigningProfileStatus
status :: Maybe SigningProfileStatus
$sel:status:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningProfileStatus
status} -> Maybe SigningProfileStatus
status) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe SigningProfileStatus
a -> GetSigningProfileResponse
s {$sel:status:GetSigningProfileResponse' :: Maybe SigningProfileStatus
status = Maybe SigningProfileStatus
a} :: GetSigningProfileResponse)

-- | Reason for the status of the target signing profile.
getSigningProfileResponse_statusReason :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe Prelude.Text)
getSigningProfileResponse_statusReason :: Lens' GetSigningProfileResponse (Maybe Text)
getSigningProfileResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe Text
a -> GetSigningProfileResponse
s {$sel:statusReason:GetSigningProfileResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetSigningProfileResponse)

-- | A list of tags associated with the signing profile.
getSigningProfileResponse_tags :: Lens.Lens' GetSigningProfileResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getSigningProfileResponse_tags :: Lens' GetSigningProfileResponse (Maybe (HashMap Text Text))
getSigningProfileResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningProfileResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetSigningProfileResponse
s@GetSigningProfileResponse' {} Maybe (HashMap Text Text)
a -> GetSigningProfileResponse
s {$sel:tags:GetSigningProfileResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetSigningProfileResponse) 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

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

instance Prelude.NFData GetSigningProfileResponse where
  rnf :: GetSigningProfileResponse -> ()
rnf GetSigningProfileResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe SigningMaterial
Maybe SigningPlatformOverrides
Maybe SigningProfileRevocationRecord
Maybe SigningProfileStatus
Maybe SignatureValidityPeriod
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
status :: Maybe SigningProfileStatus
signingParameters :: Maybe (HashMap Text Text)
signingMaterial :: Maybe SigningMaterial
signatureValidityPeriod :: Maybe SignatureValidityPeriod
revocationRecord :: Maybe SigningProfileRevocationRecord
profileVersionArn :: Maybe Text
profileVersion :: Maybe Text
profileName :: Maybe Text
platformId :: Maybe Text
platformDisplayName :: Maybe Text
overrides :: Maybe SigningPlatformOverrides
arn :: Maybe Text
$sel:httpStatus:GetSigningProfileResponse' :: GetSigningProfileResponse -> Int
$sel:tags:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe (HashMap Text Text)
$sel:statusReason:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:status:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningProfileStatus
$sel:signingParameters:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe (HashMap Text Text)
$sel:signingMaterial:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningMaterial
$sel:signatureValidityPeriod:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SignatureValidityPeriod
$sel:revocationRecord:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningProfileRevocationRecord
$sel:profileVersionArn:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:profileVersion:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:profileName:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:platformId:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:platformDisplayName:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe Text
$sel:overrides:GetSigningProfileResponse' :: GetSigningProfileResponse -> Maybe SigningPlatformOverrides
$sel:arn:GetSigningProfileResponse' :: GetSigningProfileResponse -> 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 SigningPlatformOverrides
overrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformDisplayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningProfileRevocationRecord
revocationRecord
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SignatureValidityPeriod
signatureValidityPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningMaterial
signingMaterial
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
signingParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningProfileStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus