{-# 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.PutSigningProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a signing profile. A signing profile is a code signing template
-- that can be used to carry out a pre-defined signing job. For more
-- information, see
-- <http://docs.aws.amazon.com/signer/latest/developerguide/gs-profile.html>
module Amazonka.Signer.PutSigningProfile
  ( -- * Creating a Request
    PutSigningProfile (..),
    newPutSigningProfile,

    -- * Request Lenses
    putSigningProfile_overrides,
    putSigningProfile_signatureValidityPeriod,
    putSigningProfile_signingMaterial,
    putSigningProfile_signingParameters,
    putSigningProfile_tags,
    putSigningProfile_profileName,
    putSigningProfile_platformId,

    -- * Destructuring the Response
    PutSigningProfileResponse (..),
    newPutSigningProfileResponse,

    -- * Response Lenses
    putSigningProfileResponse_arn,
    putSigningProfileResponse_profileVersion,
    putSigningProfileResponse_profileVersionArn,
    putSigningProfileResponse_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:/ 'newPutSigningProfile' smart constructor.
data PutSigningProfile = PutSigningProfile'
  { -- | A subfield of @platform@. This specifies any different configuration
    -- options that you want to apply to the chosen platform (such as a
    -- different @hash-algorithm@ or @signing-algorithm@).
    PutSigningProfile -> Maybe SigningPlatformOverrides
overrides :: Prelude.Maybe SigningPlatformOverrides,
    -- | The default validity period override for any signature generated using
    -- this signing profile. If unspecified, the default is 135 months.
    PutSigningProfile -> Maybe SignatureValidityPeriod
signatureValidityPeriod :: Prelude.Maybe SignatureValidityPeriod,
    -- | The AWS Certificate Manager certificate that will be used to sign code
    -- with the new signing profile.
    PutSigningProfile -> Maybe SigningMaterial
signingMaterial :: Prelude.Maybe SigningMaterial,
    -- | Map of key-value pairs for signing. These can include any information
    -- that you want to use during signing.
    PutSigningProfile -> Maybe (HashMap Text Text)
signingParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Tags to be associated with the signing profile that is being created.
    PutSigningProfile -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the signing profile to be created.
    PutSigningProfile -> Text
profileName :: Prelude.Text,
    -- | The ID of the signing platform to be created.
    PutSigningProfile -> Text
platformId :: Prelude.Text
  }
  deriving (PutSigningProfile -> PutSigningProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSigningProfile -> PutSigningProfile -> Bool
$c/= :: PutSigningProfile -> PutSigningProfile -> Bool
== :: PutSigningProfile -> PutSigningProfile -> Bool
$c== :: PutSigningProfile -> PutSigningProfile -> Bool
Prelude.Eq, ReadPrec [PutSigningProfile]
ReadPrec PutSigningProfile
Int -> ReadS PutSigningProfile
ReadS [PutSigningProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutSigningProfile]
$creadListPrec :: ReadPrec [PutSigningProfile]
readPrec :: ReadPrec PutSigningProfile
$creadPrec :: ReadPrec PutSigningProfile
readList :: ReadS [PutSigningProfile]
$creadList :: ReadS [PutSigningProfile]
readsPrec :: Int -> ReadS PutSigningProfile
$creadsPrec :: Int -> ReadS PutSigningProfile
Prelude.Read, Int -> PutSigningProfile -> ShowS
[PutSigningProfile] -> ShowS
PutSigningProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSigningProfile] -> ShowS
$cshowList :: [PutSigningProfile] -> ShowS
show :: PutSigningProfile -> String
$cshow :: PutSigningProfile -> String
showsPrec :: Int -> PutSigningProfile -> ShowS
$cshowsPrec :: Int -> PutSigningProfile -> ShowS
Prelude.Show, forall x. Rep PutSigningProfile x -> PutSigningProfile
forall x. PutSigningProfile -> Rep PutSigningProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSigningProfile x -> PutSigningProfile
$cfrom :: forall x. PutSigningProfile -> Rep PutSigningProfile x
Prelude.Generic)

-- |
-- Create a value of 'PutSigningProfile' 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:
--
-- 'overrides', 'putSigningProfile_overrides' - A subfield of @platform@. This specifies any different configuration
-- options that you want to apply to the chosen platform (such as a
-- different @hash-algorithm@ or @signing-algorithm@).
--
-- 'signatureValidityPeriod', 'putSigningProfile_signatureValidityPeriod' - The default validity period override for any signature generated using
-- this signing profile. If unspecified, the default is 135 months.
--
-- 'signingMaterial', 'putSigningProfile_signingMaterial' - The AWS Certificate Manager certificate that will be used to sign code
-- with the new signing profile.
--
-- 'signingParameters', 'putSigningProfile_signingParameters' - Map of key-value pairs for signing. These can include any information
-- that you want to use during signing.
--
-- 'tags', 'putSigningProfile_tags' - Tags to be associated with the signing profile that is being created.
--
-- 'profileName', 'putSigningProfile_profileName' - The name of the signing profile to be created.
--
-- 'platformId', 'putSigningProfile_platformId' - The ID of the signing platform to be created.
newPutSigningProfile ::
  -- | 'profileName'
  Prelude.Text ->
  -- | 'platformId'
  Prelude.Text ->
  PutSigningProfile
newPutSigningProfile :: Text -> Text -> PutSigningProfile
newPutSigningProfile Text
pProfileName_ Text
pPlatformId_ =
  PutSigningProfile'
    { $sel:overrides:PutSigningProfile' :: Maybe SigningPlatformOverrides
overrides = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureValidityPeriod:PutSigningProfile' :: Maybe SignatureValidityPeriod
signatureValidityPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:signingMaterial:PutSigningProfile' :: Maybe SigningMaterial
signingMaterial = forall a. Maybe a
Prelude.Nothing,
      $sel:signingParameters:PutSigningProfile' :: Maybe (HashMap Text Text)
signingParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:PutSigningProfile' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:profileName:PutSigningProfile' :: Text
profileName = Text
pProfileName_,
      $sel:platformId:PutSigningProfile' :: Text
platformId = Text
pPlatformId_
    }

-- | A subfield of @platform@. This specifies any different configuration
-- options that you want to apply to the chosen platform (such as a
-- different @hash-algorithm@ or @signing-algorithm@).
putSigningProfile_overrides :: Lens.Lens' PutSigningProfile (Prelude.Maybe SigningPlatformOverrides)
putSigningProfile_overrides :: Lens' PutSigningProfile (Maybe SigningPlatformOverrides)
putSigningProfile_overrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Maybe SigningPlatformOverrides
overrides :: Maybe SigningPlatformOverrides
$sel:overrides:PutSigningProfile' :: PutSigningProfile -> Maybe SigningPlatformOverrides
overrides} -> Maybe SigningPlatformOverrides
overrides) (\s :: PutSigningProfile
s@PutSigningProfile' {} Maybe SigningPlatformOverrides
a -> PutSigningProfile
s {$sel:overrides:PutSigningProfile' :: Maybe SigningPlatformOverrides
overrides = Maybe SigningPlatformOverrides
a} :: PutSigningProfile)

-- | The default validity period override for any signature generated using
-- this signing profile. If unspecified, the default is 135 months.
putSigningProfile_signatureValidityPeriod :: Lens.Lens' PutSigningProfile (Prelude.Maybe SignatureValidityPeriod)
putSigningProfile_signatureValidityPeriod :: Lens' PutSigningProfile (Maybe SignatureValidityPeriod)
putSigningProfile_signatureValidityPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Maybe SignatureValidityPeriod
signatureValidityPeriod :: Maybe SignatureValidityPeriod
$sel:signatureValidityPeriod:PutSigningProfile' :: PutSigningProfile -> Maybe SignatureValidityPeriod
signatureValidityPeriod} -> Maybe SignatureValidityPeriod
signatureValidityPeriod) (\s :: PutSigningProfile
s@PutSigningProfile' {} Maybe SignatureValidityPeriod
a -> PutSigningProfile
s {$sel:signatureValidityPeriod:PutSigningProfile' :: Maybe SignatureValidityPeriod
signatureValidityPeriod = Maybe SignatureValidityPeriod
a} :: PutSigningProfile)

-- | The AWS Certificate Manager certificate that will be used to sign code
-- with the new signing profile.
putSigningProfile_signingMaterial :: Lens.Lens' PutSigningProfile (Prelude.Maybe SigningMaterial)
putSigningProfile_signingMaterial :: Lens' PutSigningProfile (Maybe SigningMaterial)
putSigningProfile_signingMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Maybe SigningMaterial
signingMaterial :: Maybe SigningMaterial
$sel:signingMaterial:PutSigningProfile' :: PutSigningProfile -> Maybe SigningMaterial
signingMaterial} -> Maybe SigningMaterial
signingMaterial) (\s :: PutSigningProfile
s@PutSigningProfile' {} Maybe SigningMaterial
a -> PutSigningProfile
s {$sel:signingMaterial:PutSigningProfile' :: Maybe SigningMaterial
signingMaterial = Maybe SigningMaterial
a} :: PutSigningProfile)

-- | Map of key-value pairs for signing. These can include any information
-- that you want to use during signing.
putSigningProfile_signingParameters :: Lens.Lens' PutSigningProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putSigningProfile_signingParameters :: Lens' PutSigningProfile (Maybe (HashMap Text Text))
putSigningProfile_signingParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
$sel:signingParameters:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
signingParameters} -> Maybe (HashMap Text Text)
signingParameters) (\s :: PutSigningProfile
s@PutSigningProfile' {} Maybe (HashMap Text Text)
a -> PutSigningProfile
s {$sel:signingParameters:PutSigningProfile' :: Maybe (HashMap Text Text)
signingParameters = Maybe (HashMap Text Text)
a} :: PutSigningProfile) 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

-- | Tags to be associated with the signing profile that is being created.
putSigningProfile_tags :: Lens.Lens' PutSigningProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putSigningProfile_tags :: Lens' PutSigningProfile (Maybe (HashMap Text Text))
putSigningProfile_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutSigningProfile
s@PutSigningProfile' {} Maybe (HashMap Text Text)
a -> PutSigningProfile
s {$sel:tags:PutSigningProfile' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutSigningProfile) 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 name of the signing profile to be created.
putSigningProfile_profileName :: Lens.Lens' PutSigningProfile Prelude.Text
putSigningProfile_profileName :: Lens' PutSigningProfile Text
putSigningProfile_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Text
profileName :: Text
$sel:profileName:PutSigningProfile' :: PutSigningProfile -> Text
profileName} -> Text
profileName) (\s :: PutSigningProfile
s@PutSigningProfile' {} Text
a -> PutSigningProfile
s {$sel:profileName:PutSigningProfile' :: Text
profileName = Text
a} :: PutSigningProfile)

-- | The ID of the signing platform to be created.
putSigningProfile_platformId :: Lens.Lens' PutSigningProfile Prelude.Text
putSigningProfile_platformId :: Lens' PutSigningProfile Text
putSigningProfile_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSigningProfile' {Text
platformId :: Text
$sel:platformId:PutSigningProfile' :: PutSigningProfile -> Text
platformId} -> Text
platformId) (\s :: PutSigningProfile
s@PutSigningProfile' {} Text
a -> PutSigningProfile
s {$sel:platformId:PutSigningProfile' :: Text
platformId = Text
a} :: PutSigningProfile)

instance Core.AWSRequest PutSigningProfile where
  type
    AWSResponse PutSigningProfile =
      PutSigningProfileResponse
  request :: (Service -> Service)
-> PutSigningProfile -> Request PutSigningProfile
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 PutSigningProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutSigningProfile)))
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 Text -> Maybe Text -> Int -> PutSigningProfileResponse
PutSigningProfileResponse'
            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
"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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PutSigningProfile where
  hashWithSalt :: Int -> PutSigningProfile -> Int
hashWithSalt Int
_salt PutSigningProfile' {Maybe (HashMap Text Text)
Maybe SigningMaterial
Maybe SigningPlatformOverrides
Maybe SignatureValidityPeriod
Text
platformId :: Text
profileName :: Text
tags :: Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
signingMaterial :: Maybe SigningMaterial
signatureValidityPeriod :: Maybe SignatureValidityPeriod
overrides :: Maybe SigningPlatformOverrides
$sel:platformId:PutSigningProfile' :: PutSigningProfile -> Text
$sel:profileName:PutSigningProfile' :: PutSigningProfile -> Text
$sel:tags:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingParameters:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingMaterial:PutSigningProfile' :: PutSigningProfile -> Maybe SigningMaterial
$sel:signatureValidityPeriod:PutSigningProfile' :: PutSigningProfile -> Maybe SignatureValidityPeriod
$sel:overrides:PutSigningProfile' :: PutSigningProfile -> Maybe SigningPlatformOverrides
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningPlatformOverrides
overrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SignatureValidityPeriod
signatureValidityPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningMaterial
signingMaterial
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
signingParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platformId

instance Prelude.NFData PutSigningProfile where
  rnf :: PutSigningProfile -> ()
rnf PutSigningProfile' {Maybe (HashMap Text Text)
Maybe SigningMaterial
Maybe SigningPlatformOverrides
Maybe SignatureValidityPeriod
Text
platformId :: Text
profileName :: Text
tags :: Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
signingMaterial :: Maybe SigningMaterial
signatureValidityPeriod :: Maybe SignatureValidityPeriod
overrides :: Maybe SigningPlatformOverrides
$sel:platformId:PutSigningProfile' :: PutSigningProfile -> Text
$sel:profileName:PutSigningProfile' :: PutSigningProfile -> Text
$sel:tags:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingParameters:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingMaterial:PutSigningProfile' :: PutSigningProfile -> Maybe SigningMaterial
$sel:signatureValidityPeriod:PutSigningProfile' :: PutSigningProfile -> Maybe SignatureValidityPeriod
$sel:overrides:PutSigningProfile' :: PutSigningProfile -> Maybe SigningPlatformOverrides
..} =
    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 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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
platformId

instance Data.ToHeaders PutSigningProfile where
  toHeaders :: PutSigningProfile -> 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.ToJSON PutSigningProfile where
  toJSON :: PutSigningProfile -> Value
toJSON PutSigningProfile' {Maybe (HashMap Text Text)
Maybe SigningMaterial
Maybe SigningPlatformOverrides
Maybe SignatureValidityPeriod
Text
platformId :: Text
profileName :: Text
tags :: Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
signingMaterial :: Maybe SigningMaterial
signatureValidityPeriod :: Maybe SignatureValidityPeriod
overrides :: Maybe SigningPlatformOverrides
$sel:platformId:PutSigningProfile' :: PutSigningProfile -> Text
$sel:profileName:PutSigningProfile' :: PutSigningProfile -> Text
$sel:tags:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingParameters:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingMaterial:PutSigningProfile' :: PutSigningProfile -> Maybe SigningMaterial
$sel:signatureValidityPeriod:PutSigningProfile' :: PutSigningProfile -> Maybe SignatureValidityPeriod
$sel:overrides:PutSigningProfile' :: PutSigningProfile -> Maybe SigningPlatformOverrides
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"overrides" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SigningPlatformOverrides
overrides,
            (Key
"signatureValidityPeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SignatureValidityPeriod
signatureValidityPeriod,
            (Key
"signingMaterial" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SigningMaterial
signingMaterial,
            (Key
"signingParameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
signingParameters,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"platformId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
platformId)
          ]
      )

instance Data.ToPath PutSigningProfile where
  toPath :: PutSigningProfile -> ByteString
toPath PutSigningProfile' {Maybe (HashMap Text Text)
Maybe SigningMaterial
Maybe SigningPlatformOverrides
Maybe SignatureValidityPeriod
Text
platformId :: Text
profileName :: Text
tags :: Maybe (HashMap Text Text)
signingParameters :: Maybe (HashMap Text Text)
signingMaterial :: Maybe SigningMaterial
signatureValidityPeriod :: Maybe SignatureValidityPeriod
overrides :: Maybe SigningPlatformOverrides
$sel:platformId:PutSigningProfile' :: PutSigningProfile -> Text
$sel:profileName:PutSigningProfile' :: PutSigningProfile -> Text
$sel:tags:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingParameters:PutSigningProfile' :: PutSigningProfile -> Maybe (HashMap Text Text)
$sel:signingMaterial:PutSigningProfile' :: PutSigningProfile -> Maybe SigningMaterial
$sel:signatureValidityPeriod:PutSigningProfile' :: PutSigningProfile -> Maybe SignatureValidityPeriod
$sel:overrides:PutSigningProfile' :: PutSigningProfile -> Maybe SigningPlatformOverrides
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/signing-profiles/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
profileName]

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

-- | /See:/ 'newPutSigningProfileResponse' smart constructor.
data PutSigningProfileResponse = PutSigningProfileResponse'
  { -- | The Amazon Resource Name (ARN) of the signing profile created.
    PutSigningProfileResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The version of the signing profile being created.
    PutSigningProfileResponse -> Maybe Text
profileVersion :: Prelude.Maybe Prelude.Text,
    -- | The signing profile ARN, including the profile version.
    PutSigningProfileResponse -> Maybe Text
profileVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutSigningProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutSigningProfileResponse -> PutSigningProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSigningProfileResponse -> PutSigningProfileResponse -> Bool
$c/= :: PutSigningProfileResponse -> PutSigningProfileResponse -> Bool
== :: PutSigningProfileResponse -> PutSigningProfileResponse -> Bool
$c== :: PutSigningProfileResponse -> PutSigningProfileResponse -> Bool
Prelude.Eq, ReadPrec [PutSigningProfileResponse]
ReadPrec PutSigningProfileResponse
Int -> ReadS PutSigningProfileResponse
ReadS [PutSigningProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutSigningProfileResponse]
$creadListPrec :: ReadPrec [PutSigningProfileResponse]
readPrec :: ReadPrec PutSigningProfileResponse
$creadPrec :: ReadPrec PutSigningProfileResponse
readList :: ReadS [PutSigningProfileResponse]
$creadList :: ReadS [PutSigningProfileResponse]
readsPrec :: Int -> ReadS PutSigningProfileResponse
$creadsPrec :: Int -> ReadS PutSigningProfileResponse
Prelude.Read, Int -> PutSigningProfileResponse -> ShowS
[PutSigningProfileResponse] -> ShowS
PutSigningProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSigningProfileResponse] -> ShowS
$cshowList :: [PutSigningProfileResponse] -> ShowS
show :: PutSigningProfileResponse -> String
$cshow :: PutSigningProfileResponse -> String
showsPrec :: Int -> PutSigningProfileResponse -> ShowS
$cshowsPrec :: Int -> PutSigningProfileResponse -> ShowS
Prelude.Show, forall x.
Rep PutSigningProfileResponse x -> PutSigningProfileResponse
forall x.
PutSigningProfileResponse -> Rep PutSigningProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutSigningProfileResponse x -> PutSigningProfileResponse
$cfrom :: forall x.
PutSigningProfileResponse -> Rep PutSigningProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutSigningProfileResponse' 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', 'putSigningProfileResponse_arn' - The Amazon Resource Name (ARN) of the signing profile created.
--
-- 'profileVersion', 'putSigningProfileResponse_profileVersion' - The version of the signing profile being created.
--
-- 'profileVersionArn', 'putSigningProfileResponse_profileVersionArn' - The signing profile ARN, including the profile version.
--
-- 'httpStatus', 'putSigningProfileResponse_httpStatus' - The response's http status code.
newPutSigningProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutSigningProfileResponse
newPutSigningProfileResponse :: Int -> PutSigningProfileResponse
newPutSigningProfileResponse Int
pHttpStatus_ =
  PutSigningProfileResponse'
    { $sel:arn:PutSigningProfileResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:profileVersion:PutSigningProfileResponse' :: Maybe Text
profileVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:profileVersionArn:PutSigningProfileResponse' :: Maybe Text
profileVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutSigningProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

instance Prelude.NFData PutSigningProfileResponse where
  rnf :: PutSigningProfileResponse -> ()
rnf PutSigningProfileResponse' {Int
Maybe Text
httpStatus :: Int
profileVersionArn :: Maybe Text
profileVersion :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:PutSigningProfileResponse' :: PutSigningProfileResponse -> Int
$sel:profileVersionArn:PutSigningProfileResponse' :: PutSigningProfileResponse -> Maybe Text
$sel:profileVersion:PutSigningProfileResponse' :: PutSigningProfileResponse -> Maybe Text
$sel:arn:PutSigningProfileResponse' :: PutSigningProfileResponse -> 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 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 Int
httpStatus