{-# 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.Lambda.UpdateCodeSigningConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update the code signing configuration. Changes to the code signing
-- configuration take effect the next time a user tries to deploy a code
-- package to the function.
module Amazonka.Lambda.UpdateCodeSigningConfig
  ( -- * Creating a Request
    UpdateCodeSigningConfig (..),
    newUpdateCodeSigningConfig,

    -- * Request Lenses
    updateCodeSigningConfig_allowedPublishers,
    updateCodeSigningConfig_codeSigningPolicies,
    updateCodeSigningConfig_description,
    updateCodeSigningConfig_codeSigningConfigArn,

    -- * Destructuring the Response
    UpdateCodeSigningConfigResponse (..),
    newUpdateCodeSigningConfigResponse,

    -- * Response Lenses
    updateCodeSigningConfigResponse_httpStatus,
    updateCodeSigningConfigResponse_codeSigningConfig,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lambda.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateCodeSigningConfig' smart constructor.
data UpdateCodeSigningConfig = UpdateCodeSigningConfig'
  { -- | Signing profiles for this code signing configuration.
    UpdateCodeSigningConfig -> Maybe AllowedPublishers
allowedPublishers :: Prelude.Maybe AllowedPublishers,
    -- | The code signing policy.
    UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
codeSigningPolicies :: Prelude.Maybe CodeSigningPolicies,
    -- | Descriptive name for this code signing configuration.
    UpdateCodeSigningConfig -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The The Amazon Resource Name (ARN) of the code signing configuration.
    UpdateCodeSigningConfig -> Text
codeSigningConfigArn :: Prelude.Text
  }
  deriving (UpdateCodeSigningConfig -> UpdateCodeSigningConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCodeSigningConfig -> UpdateCodeSigningConfig -> Bool
$c/= :: UpdateCodeSigningConfig -> UpdateCodeSigningConfig -> Bool
== :: UpdateCodeSigningConfig -> UpdateCodeSigningConfig -> Bool
$c== :: UpdateCodeSigningConfig -> UpdateCodeSigningConfig -> Bool
Prelude.Eq, ReadPrec [UpdateCodeSigningConfig]
ReadPrec UpdateCodeSigningConfig
Int -> ReadS UpdateCodeSigningConfig
ReadS [UpdateCodeSigningConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCodeSigningConfig]
$creadListPrec :: ReadPrec [UpdateCodeSigningConfig]
readPrec :: ReadPrec UpdateCodeSigningConfig
$creadPrec :: ReadPrec UpdateCodeSigningConfig
readList :: ReadS [UpdateCodeSigningConfig]
$creadList :: ReadS [UpdateCodeSigningConfig]
readsPrec :: Int -> ReadS UpdateCodeSigningConfig
$creadsPrec :: Int -> ReadS UpdateCodeSigningConfig
Prelude.Read, Int -> UpdateCodeSigningConfig -> ShowS
[UpdateCodeSigningConfig] -> ShowS
UpdateCodeSigningConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCodeSigningConfig] -> ShowS
$cshowList :: [UpdateCodeSigningConfig] -> ShowS
show :: UpdateCodeSigningConfig -> String
$cshow :: UpdateCodeSigningConfig -> String
showsPrec :: Int -> UpdateCodeSigningConfig -> ShowS
$cshowsPrec :: Int -> UpdateCodeSigningConfig -> ShowS
Prelude.Show, forall x. Rep UpdateCodeSigningConfig x -> UpdateCodeSigningConfig
forall x. UpdateCodeSigningConfig -> Rep UpdateCodeSigningConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCodeSigningConfig x -> UpdateCodeSigningConfig
$cfrom :: forall x. UpdateCodeSigningConfig -> Rep UpdateCodeSigningConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCodeSigningConfig' 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:
--
-- 'allowedPublishers', 'updateCodeSigningConfig_allowedPublishers' - Signing profiles for this code signing configuration.
--
-- 'codeSigningPolicies', 'updateCodeSigningConfig_codeSigningPolicies' - The code signing policy.
--
-- 'description', 'updateCodeSigningConfig_description' - Descriptive name for this code signing configuration.
--
-- 'codeSigningConfigArn', 'updateCodeSigningConfig_codeSigningConfigArn' - The The Amazon Resource Name (ARN) of the code signing configuration.
newUpdateCodeSigningConfig ::
  -- | 'codeSigningConfigArn'
  Prelude.Text ->
  UpdateCodeSigningConfig
newUpdateCodeSigningConfig :: Text -> UpdateCodeSigningConfig
newUpdateCodeSigningConfig Text
pCodeSigningConfigArn_ =
  UpdateCodeSigningConfig'
    { $sel:allowedPublishers:UpdateCodeSigningConfig' :: Maybe AllowedPublishers
allowedPublishers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:codeSigningPolicies:UpdateCodeSigningConfig' :: Maybe CodeSigningPolicies
codeSigningPolicies = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateCodeSigningConfig' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: Text
codeSigningConfigArn = Text
pCodeSigningConfigArn_
    }

-- | Signing profiles for this code signing configuration.
updateCodeSigningConfig_allowedPublishers :: Lens.Lens' UpdateCodeSigningConfig (Prelude.Maybe AllowedPublishers)
updateCodeSigningConfig_allowedPublishers :: Lens' UpdateCodeSigningConfig (Maybe AllowedPublishers)
updateCodeSigningConfig_allowedPublishers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeSigningConfig' {Maybe AllowedPublishers
allowedPublishers :: Maybe AllowedPublishers
$sel:allowedPublishers:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe AllowedPublishers
allowedPublishers} -> Maybe AllowedPublishers
allowedPublishers) (\s :: UpdateCodeSigningConfig
s@UpdateCodeSigningConfig' {} Maybe AllowedPublishers
a -> UpdateCodeSigningConfig
s {$sel:allowedPublishers:UpdateCodeSigningConfig' :: Maybe AllowedPublishers
allowedPublishers = Maybe AllowedPublishers
a} :: UpdateCodeSigningConfig)

-- | The code signing policy.
updateCodeSigningConfig_codeSigningPolicies :: Lens.Lens' UpdateCodeSigningConfig (Prelude.Maybe CodeSigningPolicies)
updateCodeSigningConfig_codeSigningPolicies :: Lens' UpdateCodeSigningConfig (Maybe CodeSigningPolicies)
updateCodeSigningConfig_codeSigningPolicies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeSigningConfig' {Maybe CodeSigningPolicies
codeSigningPolicies :: Maybe CodeSigningPolicies
$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
codeSigningPolicies} -> Maybe CodeSigningPolicies
codeSigningPolicies) (\s :: UpdateCodeSigningConfig
s@UpdateCodeSigningConfig' {} Maybe CodeSigningPolicies
a -> UpdateCodeSigningConfig
s {$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: Maybe CodeSigningPolicies
codeSigningPolicies = Maybe CodeSigningPolicies
a} :: UpdateCodeSigningConfig)

-- | Descriptive name for this code signing configuration.
updateCodeSigningConfig_description :: Lens.Lens' UpdateCodeSigningConfig (Prelude.Maybe Prelude.Text)
updateCodeSigningConfig_description :: Lens' UpdateCodeSigningConfig (Maybe Text)
updateCodeSigningConfig_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeSigningConfig' {Maybe Text
description :: Maybe Text
$sel:description:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateCodeSigningConfig
s@UpdateCodeSigningConfig' {} Maybe Text
a -> UpdateCodeSigningConfig
s {$sel:description:UpdateCodeSigningConfig' :: Maybe Text
description = Maybe Text
a} :: UpdateCodeSigningConfig)

-- | The The Amazon Resource Name (ARN) of the code signing configuration.
updateCodeSigningConfig_codeSigningConfigArn :: Lens.Lens' UpdateCodeSigningConfig Prelude.Text
updateCodeSigningConfig_codeSigningConfigArn :: Lens' UpdateCodeSigningConfig Text
updateCodeSigningConfig_codeSigningConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeSigningConfig' {Text
codeSigningConfigArn :: Text
$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Text
codeSigningConfigArn} -> Text
codeSigningConfigArn) (\s :: UpdateCodeSigningConfig
s@UpdateCodeSigningConfig' {} Text
a -> UpdateCodeSigningConfig
s {$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: Text
codeSigningConfigArn = Text
a} :: UpdateCodeSigningConfig)

instance Core.AWSRequest UpdateCodeSigningConfig where
  type
    AWSResponse UpdateCodeSigningConfig =
      UpdateCodeSigningConfigResponse
  request :: (Service -> Service)
-> UpdateCodeSigningConfig -> Request UpdateCodeSigningConfig
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 UpdateCodeSigningConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateCodeSigningConfig)))
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 ->
          Int -> CodeSigningConfig -> UpdateCodeSigningConfigResponse
UpdateCodeSigningConfigResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CodeSigningConfig")
      )

instance Prelude.Hashable UpdateCodeSigningConfig where
  hashWithSalt :: Int -> UpdateCodeSigningConfig -> Int
hashWithSalt Int
_salt UpdateCodeSigningConfig' {Maybe Text
Maybe AllowedPublishers
Maybe CodeSigningPolicies
Text
codeSigningConfigArn :: Text
description :: Maybe Text
codeSigningPolicies :: Maybe CodeSigningPolicies
allowedPublishers :: Maybe AllowedPublishers
$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Text
$sel:description:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe Text
$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
$sel:allowedPublishers:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe AllowedPublishers
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AllowedPublishers
allowedPublishers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CodeSigningPolicies
codeSigningPolicies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
codeSigningConfigArn

instance Prelude.NFData UpdateCodeSigningConfig where
  rnf :: UpdateCodeSigningConfig -> ()
rnf UpdateCodeSigningConfig' {Maybe Text
Maybe AllowedPublishers
Maybe CodeSigningPolicies
Text
codeSigningConfigArn :: Text
description :: Maybe Text
codeSigningPolicies :: Maybe CodeSigningPolicies
allowedPublishers :: Maybe AllowedPublishers
$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Text
$sel:description:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe Text
$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
$sel:allowedPublishers:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe AllowedPublishers
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AllowedPublishers
allowedPublishers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CodeSigningPolicies
codeSigningPolicies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
codeSigningConfigArn

instance Data.ToHeaders UpdateCodeSigningConfig where
  toHeaders :: UpdateCodeSigningConfig -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateCodeSigningConfig where
  toJSON :: UpdateCodeSigningConfig -> Value
toJSON UpdateCodeSigningConfig' {Maybe Text
Maybe AllowedPublishers
Maybe CodeSigningPolicies
Text
codeSigningConfigArn :: Text
description :: Maybe Text
codeSigningPolicies :: Maybe CodeSigningPolicies
allowedPublishers :: Maybe AllowedPublishers
$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Text
$sel:description:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe Text
$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
$sel:allowedPublishers:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe AllowedPublishers
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowedPublishers" 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 AllowedPublishers
allowedPublishers,
            (Key
"CodeSigningPolicies" 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 CodeSigningPolicies
codeSigningPolicies,
            (Key
"Description" 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 Text
description
          ]
      )

instance Data.ToPath UpdateCodeSigningConfig where
  toPath :: UpdateCodeSigningConfig -> ByteString
toPath UpdateCodeSigningConfig' {Maybe Text
Maybe AllowedPublishers
Maybe CodeSigningPolicies
Text
codeSigningConfigArn :: Text
description :: Maybe Text
codeSigningPolicies :: Maybe CodeSigningPolicies
allowedPublishers :: Maybe AllowedPublishers
$sel:codeSigningConfigArn:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Text
$sel:description:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe Text
$sel:codeSigningPolicies:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe CodeSigningPolicies
$sel:allowedPublishers:UpdateCodeSigningConfig' :: UpdateCodeSigningConfig -> Maybe AllowedPublishers
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-04-22/code-signing-configs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
codeSigningConfigArn
      ]

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

-- | /See:/ 'newUpdateCodeSigningConfigResponse' smart constructor.
data UpdateCodeSigningConfigResponse = UpdateCodeSigningConfigResponse'
  { -- | The response's http status code.
    UpdateCodeSigningConfigResponse -> Int
httpStatus :: Prelude.Int,
    -- | The code signing configuration
    UpdateCodeSigningConfigResponse -> CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
  }
  deriving (UpdateCodeSigningConfigResponse
-> UpdateCodeSigningConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCodeSigningConfigResponse
-> UpdateCodeSigningConfigResponse -> Bool
$c/= :: UpdateCodeSigningConfigResponse
-> UpdateCodeSigningConfigResponse -> Bool
== :: UpdateCodeSigningConfigResponse
-> UpdateCodeSigningConfigResponse -> Bool
$c== :: UpdateCodeSigningConfigResponse
-> UpdateCodeSigningConfigResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCodeSigningConfigResponse]
ReadPrec UpdateCodeSigningConfigResponse
Int -> ReadS UpdateCodeSigningConfigResponse
ReadS [UpdateCodeSigningConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCodeSigningConfigResponse]
$creadListPrec :: ReadPrec [UpdateCodeSigningConfigResponse]
readPrec :: ReadPrec UpdateCodeSigningConfigResponse
$creadPrec :: ReadPrec UpdateCodeSigningConfigResponse
readList :: ReadS [UpdateCodeSigningConfigResponse]
$creadList :: ReadS [UpdateCodeSigningConfigResponse]
readsPrec :: Int -> ReadS UpdateCodeSigningConfigResponse
$creadsPrec :: Int -> ReadS UpdateCodeSigningConfigResponse
Prelude.Read, Int -> UpdateCodeSigningConfigResponse -> ShowS
[UpdateCodeSigningConfigResponse] -> ShowS
UpdateCodeSigningConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCodeSigningConfigResponse] -> ShowS
$cshowList :: [UpdateCodeSigningConfigResponse] -> ShowS
show :: UpdateCodeSigningConfigResponse -> String
$cshow :: UpdateCodeSigningConfigResponse -> String
showsPrec :: Int -> UpdateCodeSigningConfigResponse -> ShowS
$cshowsPrec :: Int -> UpdateCodeSigningConfigResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateCodeSigningConfigResponse x
-> UpdateCodeSigningConfigResponse
forall x.
UpdateCodeSigningConfigResponse
-> Rep UpdateCodeSigningConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCodeSigningConfigResponse x
-> UpdateCodeSigningConfigResponse
$cfrom :: forall x.
UpdateCodeSigningConfigResponse
-> Rep UpdateCodeSigningConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCodeSigningConfigResponse' 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:
--
-- 'httpStatus', 'updateCodeSigningConfigResponse_httpStatus' - The response's http status code.
--
-- 'codeSigningConfig', 'updateCodeSigningConfigResponse_codeSigningConfig' - The code signing configuration
newUpdateCodeSigningConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'codeSigningConfig'
  CodeSigningConfig ->
  UpdateCodeSigningConfigResponse
newUpdateCodeSigningConfigResponse :: Int -> CodeSigningConfig -> UpdateCodeSigningConfigResponse
newUpdateCodeSigningConfigResponse
  Int
pHttpStatus_
  CodeSigningConfig
pCodeSigningConfig_ =
    UpdateCodeSigningConfigResponse'
      { $sel:httpStatus:UpdateCodeSigningConfigResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:codeSigningConfig:UpdateCodeSigningConfigResponse' :: CodeSigningConfig
codeSigningConfig = CodeSigningConfig
pCodeSigningConfig_
      }

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

-- | The code signing configuration
updateCodeSigningConfigResponse_codeSigningConfig :: Lens.Lens' UpdateCodeSigningConfigResponse CodeSigningConfig
updateCodeSigningConfigResponse_codeSigningConfig :: Lens' UpdateCodeSigningConfigResponse CodeSigningConfig
updateCodeSigningConfigResponse_codeSigningConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeSigningConfigResponse' {CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
$sel:codeSigningConfig:UpdateCodeSigningConfigResponse' :: UpdateCodeSigningConfigResponse -> CodeSigningConfig
codeSigningConfig} -> CodeSigningConfig
codeSigningConfig) (\s :: UpdateCodeSigningConfigResponse
s@UpdateCodeSigningConfigResponse' {} CodeSigningConfig
a -> UpdateCodeSigningConfigResponse
s {$sel:codeSigningConfig:UpdateCodeSigningConfigResponse' :: CodeSigningConfig
codeSigningConfig = CodeSigningConfig
a} :: UpdateCodeSigningConfigResponse)

instance
  Prelude.NFData
    UpdateCodeSigningConfigResponse
  where
  rnf :: UpdateCodeSigningConfigResponse -> ()
rnf UpdateCodeSigningConfigResponse' {Int
CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
httpStatus :: Int
$sel:codeSigningConfig:UpdateCodeSigningConfigResponse' :: UpdateCodeSigningConfigResponse -> CodeSigningConfig
$sel:httpStatus:UpdateCodeSigningConfigResponse' :: UpdateCodeSigningConfigResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CodeSigningConfig
codeSigningConfig