{-# 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.GetSigningPlatform
-- 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 platform.
module Amazonka.Signer.GetSigningPlatform
  ( -- * Creating a Request
    GetSigningPlatform (..),
    newGetSigningPlatform,

    -- * Request Lenses
    getSigningPlatform_platformId,

    -- * Destructuring the Response
    GetSigningPlatformResponse (..),
    newGetSigningPlatformResponse,

    -- * Response Lenses
    getSigningPlatformResponse_category,
    getSigningPlatformResponse_displayName,
    getSigningPlatformResponse_maxSizeInMB,
    getSigningPlatformResponse_partner,
    getSigningPlatformResponse_platformId,
    getSigningPlatformResponse_revocationSupported,
    getSigningPlatformResponse_signingConfiguration,
    getSigningPlatformResponse_signingImageFormat,
    getSigningPlatformResponse_target,
    getSigningPlatformResponse_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:/ 'newGetSigningPlatform' smart constructor.
data GetSigningPlatform = GetSigningPlatform'
  { -- | The ID of the target signing platform.
    GetSigningPlatform -> Text
platformId :: Prelude.Text
  }
  deriving (GetSigningPlatform -> GetSigningPlatform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSigningPlatform -> GetSigningPlatform -> Bool
$c/= :: GetSigningPlatform -> GetSigningPlatform -> Bool
== :: GetSigningPlatform -> GetSigningPlatform -> Bool
$c== :: GetSigningPlatform -> GetSigningPlatform -> Bool
Prelude.Eq, ReadPrec [GetSigningPlatform]
ReadPrec GetSigningPlatform
Int -> ReadS GetSigningPlatform
ReadS [GetSigningPlatform]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSigningPlatform]
$creadListPrec :: ReadPrec [GetSigningPlatform]
readPrec :: ReadPrec GetSigningPlatform
$creadPrec :: ReadPrec GetSigningPlatform
readList :: ReadS [GetSigningPlatform]
$creadList :: ReadS [GetSigningPlatform]
readsPrec :: Int -> ReadS GetSigningPlatform
$creadsPrec :: Int -> ReadS GetSigningPlatform
Prelude.Read, Int -> GetSigningPlatform -> ShowS
[GetSigningPlatform] -> ShowS
GetSigningPlatform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSigningPlatform] -> ShowS
$cshowList :: [GetSigningPlatform] -> ShowS
show :: GetSigningPlatform -> String
$cshow :: GetSigningPlatform -> String
showsPrec :: Int -> GetSigningPlatform -> ShowS
$cshowsPrec :: Int -> GetSigningPlatform -> ShowS
Prelude.Show, forall x. Rep GetSigningPlatform x -> GetSigningPlatform
forall x. GetSigningPlatform -> Rep GetSigningPlatform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSigningPlatform x -> GetSigningPlatform
$cfrom :: forall x. GetSigningPlatform -> Rep GetSigningPlatform x
Prelude.Generic)

-- |
-- Create a value of 'GetSigningPlatform' 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:
--
-- 'platformId', 'getSigningPlatform_platformId' - The ID of the target signing platform.
newGetSigningPlatform ::
  -- | 'platformId'
  Prelude.Text ->
  GetSigningPlatform
newGetSigningPlatform :: Text -> GetSigningPlatform
newGetSigningPlatform Text
pPlatformId_ =
  GetSigningPlatform' {$sel:platformId:GetSigningPlatform' :: Text
platformId = Text
pPlatformId_}

-- | The ID of the target signing platform.
getSigningPlatform_platformId :: Lens.Lens' GetSigningPlatform Prelude.Text
getSigningPlatform_platformId :: Lens' GetSigningPlatform Text
getSigningPlatform_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatform' {Text
platformId :: Text
$sel:platformId:GetSigningPlatform' :: GetSigningPlatform -> Text
platformId} -> Text
platformId) (\s :: GetSigningPlatform
s@GetSigningPlatform' {} Text
a -> GetSigningPlatform
s {$sel:platformId:GetSigningPlatform' :: Text
platformId = Text
a} :: GetSigningPlatform)

instance Core.AWSRequest GetSigningPlatform where
  type
    AWSResponse GetSigningPlatform =
      GetSigningPlatformResponse
  request :: (Service -> Service)
-> GetSigningPlatform -> Request GetSigningPlatform
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 GetSigningPlatform
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSigningPlatform)))
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 Category
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe SigningConfiguration
-> Maybe SigningImageFormat
-> Maybe Text
-> Int
-> GetSigningPlatformResponse
GetSigningPlatformResponse'
            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
"category")
            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
"displayName")
            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
"maxSizeInMB")
            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
"partner")
            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
"revocationSupported")
            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
"signingConfiguration")
            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
"signingImageFormat")
            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
"target")
            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 GetSigningPlatform where
  hashWithSalt :: Int -> GetSigningPlatform -> Int
hashWithSalt Int
_salt GetSigningPlatform' {Text
platformId :: Text
$sel:platformId:GetSigningPlatform' :: GetSigningPlatform -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platformId

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

instance Data.ToHeaders GetSigningPlatform where
  toHeaders :: GetSigningPlatform -> 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 GetSigningPlatform where
  toPath :: GetSigningPlatform -> ByteString
toPath GetSigningPlatform' {Text
platformId :: Text
$sel:platformId:GetSigningPlatform' :: GetSigningPlatform -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/signing-platforms/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
platformId]

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

-- | /See:/ 'newGetSigningPlatformResponse' smart constructor.
data GetSigningPlatformResponse = GetSigningPlatformResponse'
  { -- | The category type of the target signing platform.
    GetSigningPlatformResponse -> Maybe Category
category :: Prelude.Maybe Category,
    -- | The display name of the target signing platform.
    GetSigningPlatformResponse -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The maximum size (in MB) of the payload that can be signed by the target
    -- platform.
    GetSigningPlatformResponse -> Maybe Int
maxSizeInMB :: Prelude.Maybe Prelude.Int,
    -- | A list of partner entities that use the target signing platform.
    GetSigningPlatformResponse -> Maybe Text
partner :: Prelude.Maybe Prelude.Text,
    -- | The ID of the target signing platform.
    GetSigningPlatformResponse -> Maybe Text
platformId :: Prelude.Maybe Prelude.Text,
    -- | A flag indicating whether signatures generated for the signing platform
    -- can be revoked.
    GetSigningPlatformResponse -> Maybe Bool
revocationSupported :: Prelude.Maybe Prelude.Bool,
    -- | A list of configurations applied to the target platform at signing.
    GetSigningPlatformResponse -> Maybe SigningConfiguration
signingConfiguration :: Prelude.Maybe SigningConfiguration,
    -- | The format of the target platform\'s signing image.
    GetSigningPlatformResponse -> Maybe SigningImageFormat
signingImageFormat :: Prelude.Maybe SigningImageFormat,
    -- | The validation template that is used by the target signing platform.
    GetSigningPlatformResponse -> Maybe Text
target :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetSigningPlatformResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSigningPlatformResponse -> GetSigningPlatformResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSigningPlatformResponse -> GetSigningPlatformResponse -> Bool
$c/= :: GetSigningPlatformResponse -> GetSigningPlatformResponse -> Bool
== :: GetSigningPlatformResponse -> GetSigningPlatformResponse -> Bool
$c== :: GetSigningPlatformResponse -> GetSigningPlatformResponse -> Bool
Prelude.Eq, ReadPrec [GetSigningPlatformResponse]
ReadPrec GetSigningPlatformResponse
Int -> ReadS GetSigningPlatformResponse
ReadS [GetSigningPlatformResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSigningPlatformResponse]
$creadListPrec :: ReadPrec [GetSigningPlatformResponse]
readPrec :: ReadPrec GetSigningPlatformResponse
$creadPrec :: ReadPrec GetSigningPlatformResponse
readList :: ReadS [GetSigningPlatformResponse]
$creadList :: ReadS [GetSigningPlatformResponse]
readsPrec :: Int -> ReadS GetSigningPlatformResponse
$creadsPrec :: Int -> ReadS GetSigningPlatformResponse
Prelude.Read, Int -> GetSigningPlatformResponse -> ShowS
[GetSigningPlatformResponse] -> ShowS
GetSigningPlatformResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSigningPlatformResponse] -> ShowS
$cshowList :: [GetSigningPlatformResponse] -> ShowS
show :: GetSigningPlatformResponse -> String
$cshow :: GetSigningPlatformResponse -> String
showsPrec :: Int -> GetSigningPlatformResponse -> ShowS
$cshowsPrec :: Int -> GetSigningPlatformResponse -> ShowS
Prelude.Show, forall x.
Rep GetSigningPlatformResponse x -> GetSigningPlatformResponse
forall x.
GetSigningPlatformResponse -> Rep GetSigningPlatformResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSigningPlatformResponse x -> GetSigningPlatformResponse
$cfrom :: forall x.
GetSigningPlatformResponse -> Rep GetSigningPlatformResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSigningPlatformResponse' 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:
--
-- 'category', 'getSigningPlatformResponse_category' - The category type of the target signing platform.
--
-- 'displayName', 'getSigningPlatformResponse_displayName' - The display name of the target signing platform.
--
-- 'maxSizeInMB', 'getSigningPlatformResponse_maxSizeInMB' - The maximum size (in MB) of the payload that can be signed by the target
-- platform.
--
-- 'partner', 'getSigningPlatformResponse_partner' - A list of partner entities that use the target signing platform.
--
-- 'platformId', 'getSigningPlatformResponse_platformId' - The ID of the target signing platform.
--
-- 'revocationSupported', 'getSigningPlatformResponse_revocationSupported' - A flag indicating whether signatures generated for the signing platform
-- can be revoked.
--
-- 'signingConfiguration', 'getSigningPlatformResponse_signingConfiguration' - A list of configurations applied to the target platform at signing.
--
-- 'signingImageFormat', 'getSigningPlatformResponse_signingImageFormat' - The format of the target platform\'s signing image.
--
-- 'target', 'getSigningPlatformResponse_target' - The validation template that is used by the target signing platform.
--
-- 'httpStatus', 'getSigningPlatformResponse_httpStatus' - The response's http status code.
newGetSigningPlatformResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSigningPlatformResponse
newGetSigningPlatformResponse :: Int -> GetSigningPlatformResponse
newGetSigningPlatformResponse Int
pHttpStatus_ =
  GetSigningPlatformResponse'
    { $sel:category:GetSigningPlatformResponse' :: Maybe Category
category =
        forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:GetSigningPlatformResponse' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSizeInMB:GetSigningPlatformResponse' :: Maybe Int
maxSizeInMB = forall a. Maybe a
Prelude.Nothing,
      $sel:partner:GetSigningPlatformResponse' :: Maybe Text
partner = forall a. Maybe a
Prelude.Nothing,
      $sel:platformId:GetSigningPlatformResponse' :: Maybe Text
platformId = forall a. Maybe a
Prelude.Nothing,
      $sel:revocationSupported:GetSigningPlatformResponse' :: Maybe Bool
revocationSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:signingConfiguration:GetSigningPlatformResponse' :: Maybe SigningConfiguration
signingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:signingImageFormat:GetSigningPlatformResponse' :: Maybe SigningImageFormat
signingImageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:target:GetSigningPlatformResponse' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSigningPlatformResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The category type of the target signing platform.
getSigningPlatformResponse_category :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Category)
getSigningPlatformResponse_category :: Lens' GetSigningPlatformResponse (Maybe Category)
getSigningPlatformResponse_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Category
category :: Maybe Category
$sel:category:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Category
category} -> Maybe Category
category) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Category
a -> GetSigningPlatformResponse
s {$sel:category:GetSigningPlatformResponse' :: Maybe Category
category = Maybe Category
a} :: GetSigningPlatformResponse)

-- | The display name of the target signing platform.
getSigningPlatformResponse_displayName :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Text)
getSigningPlatformResponse_displayName :: Lens' GetSigningPlatformResponse (Maybe Text)
getSigningPlatformResponse_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Text
displayName :: Maybe Text
$sel:displayName:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Text
a -> GetSigningPlatformResponse
s {$sel:displayName:GetSigningPlatformResponse' :: Maybe Text
displayName = Maybe Text
a} :: GetSigningPlatformResponse)

-- | The maximum size (in MB) of the payload that can be signed by the target
-- platform.
getSigningPlatformResponse_maxSizeInMB :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Int)
getSigningPlatformResponse_maxSizeInMB :: Lens' GetSigningPlatformResponse (Maybe Int)
getSigningPlatformResponse_maxSizeInMB = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Int
maxSizeInMB :: Maybe Int
$sel:maxSizeInMB:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Int
maxSizeInMB} -> Maybe Int
maxSizeInMB) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Int
a -> GetSigningPlatformResponse
s {$sel:maxSizeInMB:GetSigningPlatformResponse' :: Maybe Int
maxSizeInMB = Maybe Int
a} :: GetSigningPlatformResponse)

-- | A list of partner entities that use the target signing platform.
getSigningPlatformResponse_partner :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Text)
getSigningPlatformResponse_partner :: Lens' GetSigningPlatformResponse (Maybe Text)
getSigningPlatformResponse_partner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Text
partner :: Maybe Text
$sel:partner:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
partner} -> Maybe Text
partner) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Text
a -> GetSigningPlatformResponse
s {$sel:partner:GetSigningPlatformResponse' :: Maybe Text
partner = Maybe Text
a} :: GetSigningPlatformResponse)

-- | The ID of the target signing platform.
getSigningPlatformResponse_platformId :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Text)
getSigningPlatformResponse_platformId :: Lens' GetSigningPlatformResponse (Maybe Text)
getSigningPlatformResponse_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Text
platformId :: Maybe Text
$sel:platformId:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
platformId} -> Maybe Text
platformId) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Text
a -> GetSigningPlatformResponse
s {$sel:platformId:GetSigningPlatformResponse' :: Maybe Text
platformId = Maybe Text
a} :: GetSigningPlatformResponse)

-- | A flag indicating whether signatures generated for the signing platform
-- can be revoked.
getSigningPlatformResponse_revocationSupported :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Bool)
getSigningPlatformResponse_revocationSupported :: Lens' GetSigningPlatformResponse (Maybe Bool)
getSigningPlatformResponse_revocationSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Bool
revocationSupported :: Maybe Bool
$sel:revocationSupported:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Bool
revocationSupported} -> Maybe Bool
revocationSupported) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Bool
a -> GetSigningPlatformResponse
s {$sel:revocationSupported:GetSigningPlatformResponse' :: Maybe Bool
revocationSupported = Maybe Bool
a} :: GetSigningPlatformResponse)

-- | A list of configurations applied to the target platform at signing.
getSigningPlatformResponse_signingConfiguration :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe SigningConfiguration)
getSigningPlatformResponse_signingConfiguration :: Lens' GetSigningPlatformResponse (Maybe SigningConfiguration)
getSigningPlatformResponse_signingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe SigningConfiguration
signingConfiguration :: Maybe SigningConfiguration
$sel:signingConfiguration:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe SigningConfiguration
signingConfiguration} -> Maybe SigningConfiguration
signingConfiguration) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe SigningConfiguration
a -> GetSigningPlatformResponse
s {$sel:signingConfiguration:GetSigningPlatformResponse' :: Maybe SigningConfiguration
signingConfiguration = Maybe SigningConfiguration
a} :: GetSigningPlatformResponse)

-- | The format of the target platform\'s signing image.
getSigningPlatformResponse_signingImageFormat :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe SigningImageFormat)
getSigningPlatformResponse_signingImageFormat :: Lens' GetSigningPlatformResponse (Maybe SigningImageFormat)
getSigningPlatformResponse_signingImageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe SigningImageFormat
signingImageFormat :: Maybe SigningImageFormat
$sel:signingImageFormat:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe SigningImageFormat
signingImageFormat} -> Maybe SigningImageFormat
signingImageFormat) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe SigningImageFormat
a -> GetSigningPlatformResponse
s {$sel:signingImageFormat:GetSigningPlatformResponse' :: Maybe SigningImageFormat
signingImageFormat = Maybe SigningImageFormat
a} :: GetSigningPlatformResponse)

-- | The validation template that is used by the target signing platform.
getSigningPlatformResponse_target :: Lens.Lens' GetSigningPlatformResponse (Prelude.Maybe Prelude.Text)
getSigningPlatformResponse_target :: Lens' GetSigningPlatformResponse (Maybe Text)
getSigningPlatformResponse_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSigningPlatformResponse' {Maybe Text
target :: Maybe Text
$sel:target:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
target} -> Maybe Text
target) (\s :: GetSigningPlatformResponse
s@GetSigningPlatformResponse' {} Maybe Text
a -> GetSigningPlatformResponse
s {$sel:target:GetSigningPlatformResponse' :: Maybe Text
target = Maybe Text
a} :: GetSigningPlatformResponse)

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

instance Prelude.NFData GetSigningPlatformResponse where
  rnf :: GetSigningPlatformResponse -> ()
rnf GetSigningPlatformResponse' {Int
Maybe Bool
Maybe Int
Maybe Text
Maybe Category
Maybe SigningConfiguration
Maybe SigningImageFormat
httpStatus :: Int
target :: Maybe Text
signingImageFormat :: Maybe SigningImageFormat
signingConfiguration :: Maybe SigningConfiguration
revocationSupported :: Maybe Bool
platformId :: Maybe Text
partner :: Maybe Text
maxSizeInMB :: Maybe Int
displayName :: Maybe Text
category :: Maybe Category
$sel:httpStatus:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Int
$sel:target:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
$sel:signingImageFormat:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe SigningImageFormat
$sel:signingConfiguration:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe SigningConfiguration
$sel:revocationSupported:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Bool
$sel:platformId:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
$sel:partner:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
$sel:maxSizeInMB:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Int
$sel:displayName:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Text
$sel:category:GetSigningPlatformResponse' :: GetSigningPlatformResponse -> Maybe Category
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Category
category
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxSizeInMB
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
partner
      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 Bool
revocationSupported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningConfiguration
signingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningImageFormat
signingImageFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus