{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.SigningPlatform
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Signer.Types.SigningPlatform 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 Amazonka.Signer.Types.Category
import Amazonka.Signer.Types.SigningConfiguration
import Amazonka.Signer.Types.SigningImageFormat

-- | Contains information about the signing configurations and parameters
-- that are used to perform a code signing job.
--
-- /See:/ 'newSigningPlatform' smart constructor.
data SigningPlatform = SigningPlatform'
  { -- | The category of a code signing platform.
    SigningPlatform -> Maybe Category
category :: Prelude.Maybe Category,
    -- | The display name of a code signing platform.
    SigningPlatform -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The maximum size (in MB) of code that can be signed by a code signing
    -- platform.
    SigningPlatform -> Maybe Int
maxSizeInMB :: Prelude.Maybe Prelude.Int,
    -- | Any partner entities linked to a code signing platform.
    SigningPlatform -> Maybe Text
partner :: Prelude.Maybe Prelude.Text,
    -- | The ID of a code signing; platform.
    SigningPlatform -> Maybe Text
platformId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether revocation is supported for the platform.
    SigningPlatform -> Maybe Bool
revocationSupported :: Prelude.Maybe Prelude.Bool,
    -- | The configuration of a code signing platform. This includes the
    -- designated hash algorithm and encryption algorithm of a signing
    -- platform.
    SigningPlatform -> Maybe SigningConfiguration
signingConfiguration :: Prelude.Maybe SigningConfiguration,
    SigningPlatform -> Maybe SigningImageFormat
signingImageFormat :: Prelude.Maybe SigningImageFormat,
    -- | The types of targets that can be signed by a code signing platform.
    SigningPlatform -> Maybe Text
target :: Prelude.Maybe Prelude.Text
  }
  deriving (SigningPlatform -> SigningPlatform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigningPlatform -> SigningPlatform -> Bool
$c/= :: SigningPlatform -> SigningPlatform -> Bool
== :: SigningPlatform -> SigningPlatform -> Bool
$c== :: SigningPlatform -> SigningPlatform -> Bool
Prelude.Eq, ReadPrec [SigningPlatform]
ReadPrec SigningPlatform
Int -> ReadS SigningPlatform
ReadS [SigningPlatform]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SigningPlatform]
$creadListPrec :: ReadPrec [SigningPlatform]
readPrec :: ReadPrec SigningPlatform
$creadPrec :: ReadPrec SigningPlatform
readList :: ReadS [SigningPlatform]
$creadList :: ReadS [SigningPlatform]
readsPrec :: Int -> ReadS SigningPlatform
$creadsPrec :: Int -> ReadS SigningPlatform
Prelude.Read, Int -> SigningPlatform -> ShowS
[SigningPlatform] -> ShowS
SigningPlatform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigningPlatform] -> ShowS
$cshowList :: [SigningPlatform] -> ShowS
show :: SigningPlatform -> String
$cshow :: SigningPlatform -> String
showsPrec :: Int -> SigningPlatform -> ShowS
$cshowsPrec :: Int -> SigningPlatform -> ShowS
Prelude.Show, forall x. Rep SigningPlatform x -> SigningPlatform
forall x. SigningPlatform -> Rep SigningPlatform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SigningPlatform x -> SigningPlatform
$cfrom :: forall x. SigningPlatform -> Rep SigningPlatform x
Prelude.Generic)

-- |
-- Create a value of 'SigningPlatform' 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', 'signingPlatform_category' - The category of a code signing platform.
--
-- 'displayName', 'signingPlatform_displayName' - The display name of a code signing platform.
--
-- 'maxSizeInMB', 'signingPlatform_maxSizeInMB' - The maximum size (in MB) of code that can be signed by a code signing
-- platform.
--
-- 'partner', 'signingPlatform_partner' - Any partner entities linked to a code signing platform.
--
-- 'platformId', 'signingPlatform_platformId' - The ID of a code signing; platform.
--
-- 'revocationSupported', 'signingPlatform_revocationSupported' - Indicates whether revocation is supported for the platform.
--
-- 'signingConfiguration', 'signingPlatform_signingConfiguration' - The configuration of a code signing platform. This includes the
-- designated hash algorithm and encryption algorithm of a signing
-- platform.
--
-- 'signingImageFormat', 'signingPlatform_signingImageFormat' - Undocumented member.
--
-- 'target', 'signingPlatform_target' - The types of targets that can be signed by a code signing platform.
newSigningPlatform ::
  SigningPlatform
newSigningPlatform :: SigningPlatform
newSigningPlatform =
  SigningPlatform'
    { $sel:category:SigningPlatform' :: Maybe Category
category = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:SigningPlatform' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSizeInMB:SigningPlatform' :: Maybe Int
maxSizeInMB = forall a. Maybe a
Prelude.Nothing,
      $sel:partner:SigningPlatform' :: Maybe Text
partner = forall a. Maybe a
Prelude.Nothing,
      $sel:platformId:SigningPlatform' :: Maybe Text
platformId = forall a. Maybe a
Prelude.Nothing,
      $sel:revocationSupported:SigningPlatform' :: Maybe Bool
revocationSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:signingConfiguration:SigningPlatform' :: Maybe SigningConfiguration
signingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:signingImageFormat:SigningPlatform' :: Maybe SigningImageFormat
signingImageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:target:SigningPlatform' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing
    }

-- | The category of a code signing platform.
signingPlatform_category :: Lens.Lens' SigningPlatform (Prelude.Maybe Category)
signingPlatform_category :: Lens' SigningPlatform (Maybe Category)
signingPlatform_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe Category
category :: Maybe Category
$sel:category:SigningPlatform' :: SigningPlatform -> Maybe Category
category} -> Maybe Category
category) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe Category
a -> SigningPlatform
s {$sel:category:SigningPlatform' :: Maybe Category
category = Maybe Category
a} :: SigningPlatform)

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

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

-- | Any partner entities linked to a code signing platform.
signingPlatform_partner :: Lens.Lens' SigningPlatform (Prelude.Maybe Prelude.Text)
signingPlatform_partner :: Lens' SigningPlatform (Maybe Text)
signingPlatform_partner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe Text
partner :: Maybe Text
$sel:partner:SigningPlatform' :: SigningPlatform -> Maybe Text
partner} -> Maybe Text
partner) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe Text
a -> SigningPlatform
s {$sel:partner:SigningPlatform' :: Maybe Text
partner = Maybe Text
a} :: SigningPlatform)

-- | The ID of a code signing; platform.
signingPlatform_platformId :: Lens.Lens' SigningPlatform (Prelude.Maybe Prelude.Text)
signingPlatform_platformId :: Lens' SigningPlatform (Maybe Text)
signingPlatform_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe Text
platformId :: Maybe Text
$sel:platformId:SigningPlatform' :: SigningPlatform -> Maybe Text
platformId} -> Maybe Text
platformId) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe Text
a -> SigningPlatform
s {$sel:platformId:SigningPlatform' :: Maybe Text
platformId = Maybe Text
a} :: SigningPlatform)

-- | Indicates whether revocation is supported for the platform.
signingPlatform_revocationSupported :: Lens.Lens' SigningPlatform (Prelude.Maybe Prelude.Bool)
signingPlatform_revocationSupported :: Lens' SigningPlatform (Maybe Bool)
signingPlatform_revocationSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe Bool
revocationSupported :: Maybe Bool
$sel:revocationSupported:SigningPlatform' :: SigningPlatform -> Maybe Bool
revocationSupported} -> Maybe Bool
revocationSupported) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe Bool
a -> SigningPlatform
s {$sel:revocationSupported:SigningPlatform' :: Maybe Bool
revocationSupported = Maybe Bool
a} :: SigningPlatform)

-- | The configuration of a code signing platform. This includes the
-- designated hash algorithm and encryption algorithm of a signing
-- platform.
signingPlatform_signingConfiguration :: Lens.Lens' SigningPlatform (Prelude.Maybe SigningConfiguration)
signingPlatform_signingConfiguration :: Lens' SigningPlatform (Maybe SigningConfiguration)
signingPlatform_signingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe SigningConfiguration
signingConfiguration :: Maybe SigningConfiguration
$sel:signingConfiguration:SigningPlatform' :: SigningPlatform -> Maybe SigningConfiguration
signingConfiguration} -> Maybe SigningConfiguration
signingConfiguration) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe SigningConfiguration
a -> SigningPlatform
s {$sel:signingConfiguration:SigningPlatform' :: Maybe SigningConfiguration
signingConfiguration = Maybe SigningConfiguration
a} :: SigningPlatform)

-- | Undocumented member.
signingPlatform_signingImageFormat :: Lens.Lens' SigningPlatform (Prelude.Maybe SigningImageFormat)
signingPlatform_signingImageFormat :: Lens' SigningPlatform (Maybe SigningImageFormat)
signingPlatform_signingImageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe SigningImageFormat
signingImageFormat :: Maybe SigningImageFormat
$sel:signingImageFormat:SigningPlatform' :: SigningPlatform -> Maybe SigningImageFormat
signingImageFormat} -> Maybe SigningImageFormat
signingImageFormat) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe SigningImageFormat
a -> SigningPlatform
s {$sel:signingImageFormat:SigningPlatform' :: Maybe SigningImageFormat
signingImageFormat = Maybe SigningImageFormat
a} :: SigningPlatform)

-- | The types of targets that can be signed by a code signing platform.
signingPlatform_target :: Lens.Lens' SigningPlatform (Prelude.Maybe Prelude.Text)
signingPlatform_target :: Lens' SigningPlatform (Maybe Text)
signingPlatform_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SigningPlatform' {Maybe Text
target :: Maybe Text
$sel:target:SigningPlatform' :: SigningPlatform -> Maybe Text
target} -> Maybe Text
target) (\s :: SigningPlatform
s@SigningPlatform' {} Maybe Text
a -> SigningPlatform
s {$sel:target:SigningPlatform' :: Maybe Text
target = Maybe Text
a} :: SigningPlatform)

instance Data.FromJSON SigningPlatform where
  parseJSON :: Value -> Parser SigningPlatform
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SigningPlatform"
      ( \Object
x ->
          Maybe Category
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe SigningConfiguration
-> Maybe SigningImageFormat
-> Maybe Text
-> SigningPlatform
SigningPlatform'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (Maybe a)
Data..:? Key
"target")
      )

instance Prelude.Hashable SigningPlatform where
  hashWithSalt :: Int -> SigningPlatform -> Int
hashWithSalt Int
_salt SigningPlatform' {Maybe Bool
Maybe Int
Maybe Text
Maybe Category
Maybe SigningConfiguration
Maybe SigningImageFormat
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:target:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:signingImageFormat:SigningPlatform' :: SigningPlatform -> Maybe SigningImageFormat
$sel:signingConfiguration:SigningPlatform' :: SigningPlatform -> Maybe SigningConfiguration
$sel:revocationSupported:SigningPlatform' :: SigningPlatform -> Maybe Bool
$sel:platformId:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:partner:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:maxSizeInMB:SigningPlatform' :: SigningPlatform -> Maybe Int
$sel:displayName:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:category:SigningPlatform' :: SigningPlatform -> Maybe Category
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Category
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxSizeInMB
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
partner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
revocationSupported
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningConfiguration
signingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningImageFormat
signingImageFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
target

instance Prelude.NFData SigningPlatform where
  rnf :: SigningPlatform -> ()
rnf SigningPlatform' {Maybe Bool
Maybe Int
Maybe Text
Maybe Category
Maybe SigningConfiguration
Maybe SigningImageFormat
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:target:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:signingImageFormat:SigningPlatform' :: SigningPlatform -> Maybe SigningImageFormat
$sel:signingConfiguration:SigningPlatform' :: SigningPlatform -> Maybe SigningConfiguration
$sel:revocationSupported:SigningPlatform' :: SigningPlatform -> Maybe Bool
$sel:platformId:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:partner:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:maxSizeInMB:SigningPlatform' :: SigningPlatform -> Maybe Int
$sel:displayName:SigningPlatform' :: SigningPlatform -> Maybe Text
$sel:category:SigningPlatform' :: SigningPlatform -> 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