{-# 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.StartSigningJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Initiates a signing job to be performed on the code provided. Signing
-- jobs are viewable by the @ListSigningJobs@ operation for two years after
-- they are performed. Note the following requirements:
--
-- -   You must create an Amazon S3 source bucket. For more information,
--     see
--     <http://docs.aws.amazon.com/AmazonS3/latest/gsg/CreatingABucket.html Create a Bucket>
--     in the /Amazon S3 Getting Started Guide/.
--
-- -   Your S3 source bucket must be version enabled.
--
-- -   You must create an S3 destination bucket. Code signing uses your S3
--     destination bucket to write your signed code.
--
-- -   You specify the name of the source and destination buckets when
--     calling the @StartSigningJob@ operation.
--
-- -   You must also specify a request token that identifies your request
--     to code signing.
--
-- You can call the DescribeSigningJob and the ListSigningJobs actions
-- after you call @StartSigningJob@.
--
-- For a Java example that shows how to use this action, see
-- <http://docs.aws.amazon.com/acm/latest/userguide/>
module Amazonka.Signer.StartSigningJob
  ( -- * Creating a Request
    StartSigningJob (..),
    newStartSigningJob,

    -- * Request Lenses
    startSigningJob_profileOwner,
    startSigningJob_source,
    startSigningJob_destination,
    startSigningJob_profileName,
    startSigningJob_clientRequestToken,

    -- * Destructuring the Response
    StartSigningJobResponse (..),
    newStartSigningJobResponse,

    -- * Response Lenses
    startSigningJobResponse_jobId,
    startSigningJobResponse_jobOwner,
    startSigningJobResponse_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:/ 'newStartSigningJob' smart constructor.
data StartSigningJob = StartSigningJob'
  { -- | The AWS account ID of the signing profile owner.
    StartSigningJob -> Maybe Text
profileOwner :: Prelude.Maybe Prelude.Text,
    -- | The S3 bucket that contains the object to sign or a BLOB that contains
    -- your raw code.
    StartSigningJob -> Source
source :: Source,
    -- | The S3 bucket in which to save your signed object. The destination
    -- contains the name of your bucket and an optional prefix.
    StartSigningJob -> Destination
destination :: Destination,
    -- | The name of the signing profile.
    StartSigningJob -> Text
profileName :: Prelude.Text,
    -- | String that identifies the signing request. All calls after the first
    -- that use this token return the same response as the first call.
    StartSigningJob -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (StartSigningJob -> StartSigningJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSigningJob -> StartSigningJob -> Bool
$c/= :: StartSigningJob -> StartSigningJob -> Bool
== :: StartSigningJob -> StartSigningJob -> Bool
$c== :: StartSigningJob -> StartSigningJob -> Bool
Prelude.Eq, ReadPrec [StartSigningJob]
ReadPrec StartSigningJob
Int -> ReadS StartSigningJob
ReadS [StartSigningJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSigningJob]
$creadListPrec :: ReadPrec [StartSigningJob]
readPrec :: ReadPrec StartSigningJob
$creadPrec :: ReadPrec StartSigningJob
readList :: ReadS [StartSigningJob]
$creadList :: ReadS [StartSigningJob]
readsPrec :: Int -> ReadS StartSigningJob
$creadsPrec :: Int -> ReadS StartSigningJob
Prelude.Read, Int -> StartSigningJob -> ShowS
[StartSigningJob] -> ShowS
StartSigningJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSigningJob] -> ShowS
$cshowList :: [StartSigningJob] -> ShowS
show :: StartSigningJob -> String
$cshow :: StartSigningJob -> String
showsPrec :: Int -> StartSigningJob -> ShowS
$cshowsPrec :: Int -> StartSigningJob -> ShowS
Prelude.Show, forall x. Rep StartSigningJob x -> StartSigningJob
forall x. StartSigningJob -> Rep StartSigningJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSigningJob x -> StartSigningJob
$cfrom :: forall x. StartSigningJob -> Rep StartSigningJob x
Prelude.Generic)

-- |
-- Create a value of 'StartSigningJob' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'profileOwner', 'startSigningJob_profileOwner' - The AWS account ID of the signing profile owner.
--
-- 'source', 'startSigningJob_source' - The S3 bucket that contains the object to sign or a BLOB that contains
-- your raw code.
--
-- 'destination', 'startSigningJob_destination' - The S3 bucket in which to save your signed object. The destination
-- contains the name of your bucket and an optional prefix.
--
-- 'profileName', 'startSigningJob_profileName' - The name of the signing profile.
--
-- 'clientRequestToken', 'startSigningJob_clientRequestToken' - String that identifies the signing request. All calls after the first
-- that use this token return the same response as the first call.
newStartSigningJob ::
  -- | 'source'
  Source ->
  -- | 'destination'
  Destination ->
  -- | 'profileName'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  StartSigningJob
newStartSigningJob :: Source -> Destination -> Text -> Text -> StartSigningJob
newStartSigningJob
  Source
pSource_
  Destination
pDestination_
  Text
pProfileName_
  Text
pClientRequestToken_ =
    StartSigningJob'
      { $sel:profileOwner:StartSigningJob' :: Maybe Text
profileOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:source:StartSigningJob' :: Source
source = Source
pSource_,
        $sel:destination:StartSigningJob' :: Destination
destination = Destination
pDestination_,
        $sel:profileName:StartSigningJob' :: Text
profileName = Text
pProfileName_,
        $sel:clientRequestToken:StartSigningJob' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

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

-- | The S3 bucket that contains the object to sign or a BLOB that contains
-- your raw code.
startSigningJob_source :: Lens.Lens' StartSigningJob Source
startSigningJob_source :: Lens' StartSigningJob Source
startSigningJob_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSigningJob' {Source
source :: Source
$sel:source:StartSigningJob' :: StartSigningJob -> Source
source} -> Source
source) (\s :: StartSigningJob
s@StartSigningJob' {} Source
a -> StartSigningJob
s {$sel:source:StartSigningJob' :: Source
source = Source
a} :: StartSigningJob)

-- | The S3 bucket in which to save your signed object. The destination
-- contains the name of your bucket and an optional prefix.
startSigningJob_destination :: Lens.Lens' StartSigningJob Destination
startSigningJob_destination :: Lens' StartSigningJob Destination
startSigningJob_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSigningJob' {Destination
destination :: Destination
$sel:destination:StartSigningJob' :: StartSigningJob -> Destination
destination} -> Destination
destination) (\s :: StartSigningJob
s@StartSigningJob' {} Destination
a -> StartSigningJob
s {$sel:destination:StartSigningJob' :: Destination
destination = Destination
a} :: StartSigningJob)

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

-- | String that identifies the signing request. All calls after the first
-- that use this token return the same response as the first call.
startSigningJob_clientRequestToken :: Lens.Lens' StartSigningJob Prelude.Text
startSigningJob_clientRequestToken :: Lens' StartSigningJob Text
startSigningJob_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSigningJob' {Text
clientRequestToken :: Text
$sel:clientRequestToken:StartSigningJob' :: StartSigningJob -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: StartSigningJob
s@StartSigningJob' {} Text
a -> StartSigningJob
s {$sel:clientRequestToken:StartSigningJob' :: Text
clientRequestToken = Text
a} :: StartSigningJob)

instance Core.AWSRequest StartSigningJob where
  type
    AWSResponse StartSigningJob =
      StartSigningJobResponse
  request :: (Service -> Service) -> StartSigningJob -> Request StartSigningJob
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartSigningJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartSigningJob)))
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 -> Int -> StartSigningJobResponse
StartSigningJobResponse'
            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
"jobId")
            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
"jobOwner")
            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 StartSigningJob where
  hashWithSalt :: Int -> StartSigningJob -> Int
hashWithSalt Int
_salt StartSigningJob' {Maybe Text
Text
Destination
Source
clientRequestToken :: Text
profileName :: Text
destination :: Destination
source :: Source
profileOwner :: Maybe Text
$sel:clientRequestToken:StartSigningJob' :: StartSigningJob -> Text
$sel:profileName:StartSigningJob' :: StartSigningJob -> Text
$sel:destination:StartSigningJob' :: StartSigningJob -> Destination
$sel:source:StartSigningJob' :: StartSigningJob -> Source
$sel:profileOwner:StartSigningJob' :: StartSigningJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
profileOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Source
source
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Destination
destination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData StartSigningJob where
  rnf :: StartSigningJob -> ()
rnf StartSigningJob' {Maybe Text
Text
Destination
Source
clientRequestToken :: Text
profileName :: Text
destination :: Destination
source :: Source
profileOwner :: Maybe Text
$sel:clientRequestToken:StartSigningJob' :: StartSigningJob -> Text
$sel:profileName:StartSigningJob' :: StartSigningJob -> Text
$sel:destination:StartSigningJob' :: StartSigningJob -> Destination
$sel:source:StartSigningJob' :: StartSigningJob -> Source
$sel:profileOwner:StartSigningJob' :: StartSigningJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Source
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Destination
destination
      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
clientRequestToken

instance Data.ToHeaders StartSigningJob where
  toHeaders :: StartSigningJob -> 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 StartSigningJob where
  toJSON :: StartSigningJob -> Value
toJSON StartSigningJob' {Maybe Text
Text
Destination
Source
clientRequestToken :: Text
profileName :: Text
destination :: Destination
source :: Source
profileOwner :: Maybe Text
$sel:clientRequestToken:StartSigningJob' :: StartSigningJob -> Text
$sel:profileName:StartSigningJob' :: StartSigningJob -> Text
$sel:destination:StartSigningJob' :: StartSigningJob -> Destination
$sel:source:StartSigningJob' :: StartSigningJob -> Source
$sel:profileOwner:StartSigningJob' :: StartSigningJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"profileOwner" 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
profileOwner,
            forall a. a -> Maybe a
Prelude.Just (Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Source
source),
            forall a. a -> Maybe a
Prelude.Just (Key
"destination" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Destination
destination),
            forall a. a -> Maybe a
Prelude.Just (Key
"profileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
profileName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"clientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

instance Data.ToPath StartSigningJob where
  toPath :: StartSigningJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/signing-jobs"

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

-- | /See:/ 'newStartSigningJobResponse' smart constructor.
data StartSigningJobResponse = StartSigningJobResponse'
  { -- | The ID of your signing job.
    StartSigningJobResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The AWS account ID of the signing job owner.
    StartSigningJobResponse -> Maybe Text
jobOwner :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartSigningJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSigningJobResponse -> StartSigningJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSigningJobResponse -> StartSigningJobResponse -> Bool
$c/= :: StartSigningJobResponse -> StartSigningJobResponse -> Bool
== :: StartSigningJobResponse -> StartSigningJobResponse -> Bool
$c== :: StartSigningJobResponse -> StartSigningJobResponse -> Bool
Prelude.Eq, ReadPrec [StartSigningJobResponse]
ReadPrec StartSigningJobResponse
Int -> ReadS StartSigningJobResponse
ReadS [StartSigningJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSigningJobResponse]
$creadListPrec :: ReadPrec [StartSigningJobResponse]
readPrec :: ReadPrec StartSigningJobResponse
$creadPrec :: ReadPrec StartSigningJobResponse
readList :: ReadS [StartSigningJobResponse]
$creadList :: ReadS [StartSigningJobResponse]
readsPrec :: Int -> ReadS StartSigningJobResponse
$creadsPrec :: Int -> ReadS StartSigningJobResponse
Prelude.Read, Int -> StartSigningJobResponse -> ShowS
[StartSigningJobResponse] -> ShowS
StartSigningJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSigningJobResponse] -> ShowS
$cshowList :: [StartSigningJobResponse] -> ShowS
show :: StartSigningJobResponse -> String
$cshow :: StartSigningJobResponse -> String
showsPrec :: Int -> StartSigningJobResponse -> ShowS
$cshowsPrec :: Int -> StartSigningJobResponse -> ShowS
Prelude.Show, forall x. Rep StartSigningJobResponse x -> StartSigningJobResponse
forall x. StartSigningJobResponse -> Rep StartSigningJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSigningJobResponse x -> StartSigningJobResponse
$cfrom :: forall x. StartSigningJobResponse -> Rep StartSigningJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSigningJobResponse' 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:
--
-- 'jobId', 'startSigningJobResponse_jobId' - The ID of your signing job.
--
-- 'jobOwner', 'startSigningJobResponse_jobOwner' - The AWS account ID of the signing job owner.
--
-- 'httpStatus', 'startSigningJobResponse_httpStatus' - The response's http status code.
newStartSigningJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSigningJobResponse
newStartSigningJobResponse :: Int -> StartSigningJobResponse
newStartSigningJobResponse Int
pHttpStatus_ =
  StartSigningJobResponse'
    { $sel:jobId:StartSigningJobResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobOwner:StartSigningJobResponse' :: Maybe Text
jobOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSigningJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of your signing job.
startSigningJobResponse_jobId :: Lens.Lens' StartSigningJobResponse (Prelude.Maybe Prelude.Text)
startSigningJobResponse_jobId :: Lens' StartSigningJobResponse (Maybe Text)
startSigningJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSigningJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StartSigningJobResponse' :: StartSigningJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StartSigningJobResponse
s@StartSigningJobResponse' {} Maybe Text
a -> StartSigningJobResponse
s {$sel:jobId:StartSigningJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: StartSigningJobResponse)

-- | The AWS account ID of the signing job owner.
startSigningJobResponse_jobOwner :: Lens.Lens' StartSigningJobResponse (Prelude.Maybe Prelude.Text)
startSigningJobResponse_jobOwner :: Lens' StartSigningJobResponse (Maybe Text)
startSigningJobResponse_jobOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSigningJobResponse' {Maybe Text
jobOwner :: Maybe Text
$sel:jobOwner:StartSigningJobResponse' :: StartSigningJobResponse -> Maybe Text
jobOwner} -> Maybe Text
jobOwner) (\s :: StartSigningJobResponse
s@StartSigningJobResponse' {} Maybe Text
a -> StartSigningJobResponse
s {$sel:jobOwner:StartSigningJobResponse' :: Maybe Text
jobOwner = Maybe Text
a} :: StartSigningJobResponse)

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

instance Prelude.NFData StartSigningJobResponse where
  rnf :: StartSigningJobResponse -> ()
rnf StartSigningJobResponse' {Int
Maybe Text
httpStatus :: Int
jobOwner :: Maybe Text
jobId :: Maybe Text
$sel:httpStatus:StartSigningJobResponse' :: StartSigningJobResponse -> Int
$sel:jobOwner:StartSigningJobResponse' :: StartSigningJobResponse -> Maybe Text
$sel:jobId:StartSigningJobResponse' :: StartSigningJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus