{-# 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.AccessAnalyzer.StartPolicyGeneration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts the policy generation request.
module Amazonka.AccessAnalyzer.StartPolicyGeneration
  ( -- * Creating a Request
    StartPolicyGeneration (..),
    newStartPolicyGeneration,

    -- * Request Lenses
    startPolicyGeneration_clientToken,
    startPolicyGeneration_cloudTrailDetails,
    startPolicyGeneration_policyGenerationDetails,

    -- * Destructuring the Response
    StartPolicyGenerationResponse (..),
    newStartPolicyGenerationResponse,

    -- * Response Lenses
    startPolicyGenerationResponse_httpStatus,
    startPolicyGenerationResponse_jobId,
  )
where

import Amazonka.AccessAnalyzer.Types
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

-- | /See:/ 'newStartPolicyGeneration' smart constructor.
data StartPolicyGeneration = StartPolicyGeneration'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Idempotency ensures that an API request
    -- completes only once. With an idempotent request, if the original request
    -- completes successfully, the subsequent retries with the same client
    -- token return the result from the original successful request and they
    -- have no additional effect.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the Amazon Web Services SDK.
    StartPolicyGeneration -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A @CloudTrailDetails@ object that contains details about a @Trail@ that
    -- you want to analyze to generate policies.
    StartPolicyGeneration -> Maybe CloudTrailDetails
cloudTrailDetails :: Prelude.Maybe CloudTrailDetails,
    -- | Contains the ARN of the IAM entity (user or role) for which you are
    -- generating a policy.
    StartPolicyGeneration -> PolicyGenerationDetails
policyGenerationDetails :: PolicyGenerationDetails
  }
  deriving (StartPolicyGeneration -> StartPolicyGeneration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartPolicyGeneration -> StartPolicyGeneration -> Bool
$c/= :: StartPolicyGeneration -> StartPolicyGeneration -> Bool
== :: StartPolicyGeneration -> StartPolicyGeneration -> Bool
$c== :: StartPolicyGeneration -> StartPolicyGeneration -> Bool
Prelude.Eq, ReadPrec [StartPolicyGeneration]
ReadPrec StartPolicyGeneration
Int -> ReadS StartPolicyGeneration
ReadS [StartPolicyGeneration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartPolicyGeneration]
$creadListPrec :: ReadPrec [StartPolicyGeneration]
readPrec :: ReadPrec StartPolicyGeneration
$creadPrec :: ReadPrec StartPolicyGeneration
readList :: ReadS [StartPolicyGeneration]
$creadList :: ReadS [StartPolicyGeneration]
readsPrec :: Int -> ReadS StartPolicyGeneration
$creadsPrec :: Int -> ReadS StartPolicyGeneration
Prelude.Read, Int -> StartPolicyGeneration -> ShowS
[StartPolicyGeneration] -> ShowS
StartPolicyGeneration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartPolicyGeneration] -> ShowS
$cshowList :: [StartPolicyGeneration] -> ShowS
show :: StartPolicyGeneration -> String
$cshow :: StartPolicyGeneration -> String
showsPrec :: Int -> StartPolicyGeneration -> ShowS
$cshowsPrec :: Int -> StartPolicyGeneration -> ShowS
Prelude.Show, forall x. Rep StartPolicyGeneration x -> StartPolicyGeneration
forall x. StartPolicyGeneration -> Rep StartPolicyGeneration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartPolicyGeneration x -> StartPolicyGeneration
$cfrom :: forall x. StartPolicyGeneration -> Rep StartPolicyGeneration x
Prelude.Generic)

-- |
-- Create a value of 'StartPolicyGeneration' 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:
--
-- 'clientToken', 'startPolicyGeneration_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, the subsequent retries with the same client
-- token return the result from the original successful request and they
-- have no additional effect.
--
-- If you do not specify a client token, one is automatically generated by
-- the Amazon Web Services SDK.
--
-- 'cloudTrailDetails', 'startPolicyGeneration_cloudTrailDetails' - A @CloudTrailDetails@ object that contains details about a @Trail@ that
-- you want to analyze to generate policies.
--
-- 'policyGenerationDetails', 'startPolicyGeneration_policyGenerationDetails' - Contains the ARN of the IAM entity (user or role) for which you are
-- generating a policy.
newStartPolicyGeneration ::
  -- | 'policyGenerationDetails'
  PolicyGenerationDetails ->
  StartPolicyGeneration
newStartPolicyGeneration :: PolicyGenerationDetails -> StartPolicyGeneration
newStartPolicyGeneration PolicyGenerationDetails
pPolicyGenerationDetails_ =
  StartPolicyGeneration'
    { $sel:clientToken:StartPolicyGeneration' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cloudTrailDetails:StartPolicyGeneration' :: Maybe CloudTrailDetails
cloudTrailDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:policyGenerationDetails:StartPolicyGeneration' :: PolicyGenerationDetails
policyGenerationDetails = PolicyGenerationDetails
pPolicyGenerationDetails_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, the subsequent retries with the same client
-- token return the result from the original successful request and they
-- have no additional effect.
--
-- If you do not specify a client token, one is automatically generated by
-- the Amazon Web Services SDK.
startPolicyGeneration_clientToken :: Lens.Lens' StartPolicyGeneration (Prelude.Maybe Prelude.Text)
startPolicyGeneration_clientToken :: Lens' StartPolicyGeneration (Maybe Text)
startPolicyGeneration_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartPolicyGeneration' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StartPolicyGeneration
s@StartPolicyGeneration' {} Maybe Text
a -> StartPolicyGeneration
s {$sel:clientToken:StartPolicyGeneration' :: Maybe Text
clientToken = Maybe Text
a} :: StartPolicyGeneration)

-- | A @CloudTrailDetails@ object that contains details about a @Trail@ that
-- you want to analyze to generate policies.
startPolicyGeneration_cloudTrailDetails :: Lens.Lens' StartPolicyGeneration (Prelude.Maybe CloudTrailDetails)
startPolicyGeneration_cloudTrailDetails :: Lens' StartPolicyGeneration (Maybe CloudTrailDetails)
startPolicyGeneration_cloudTrailDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartPolicyGeneration' {Maybe CloudTrailDetails
cloudTrailDetails :: Maybe CloudTrailDetails
$sel:cloudTrailDetails:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe CloudTrailDetails
cloudTrailDetails} -> Maybe CloudTrailDetails
cloudTrailDetails) (\s :: StartPolicyGeneration
s@StartPolicyGeneration' {} Maybe CloudTrailDetails
a -> StartPolicyGeneration
s {$sel:cloudTrailDetails:StartPolicyGeneration' :: Maybe CloudTrailDetails
cloudTrailDetails = Maybe CloudTrailDetails
a} :: StartPolicyGeneration)

-- | Contains the ARN of the IAM entity (user or role) for which you are
-- generating a policy.
startPolicyGeneration_policyGenerationDetails :: Lens.Lens' StartPolicyGeneration PolicyGenerationDetails
startPolicyGeneration_policyGenerationDetails :: Lens' StartPolicyGeneration PolicyGenerationDetails
startPolicyGeneration_policyGenerationDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartPolicyGeneration' {PolicyGenerationDetails
policyGenerationDetails :: PolicyGenerationDetails
$sel:policyGenerationDetails:StartPolicyGeneration' :: StartPolicyGeneration -> PolicyGenerationDetails
policyGenerationDetails} -> PolicyGenerationDetails
policyGenerationDetails) (\s :: StartPolicyGeneration
s@StartPolicyGeneration' {} PolicyGenerationDetails
a -> StartPolicyGeneration
s {$sel:policyGenerationDetails:StartPolicyGeneration' :: PolicyGenerationDetails
policyGenerationDetails = PolicyGenerationDetails
a} :: StartPolicyGeneration)

instance Core.AWSRequest StartPolicyGeneration where
  type
    AWSResponse StartPolicyGeneration =
      StartPolicyGenerationResponse
  request :: (Service -> Service)
-> StartPolicyGeneration -> Request StartPolicyGeneration
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 StartPolicyGeneration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartPolicyGeneration)))
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 -> Text -> StartPolicyGenerationResponse
StartPolicyGenerationResponse'
            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
"jobId")
      )

instance Prelude.Hashable StartPolicyGeneration where
  hashWithSalt :: Int -> StartPolicyGeneration -> Int
hashWithSalt Int
_salt StartPolicyGeneration' {Maybe Text
Maybe CloudTrailDetails
PolicyGenerationDetails
policyGenerationDetails :: PolicyGenerationDetails
cloudTrailDetails :: Maybe CloudTrailDetails
clientToken :: Maybe Text
$sel:policyGenerationDetails:StartPolicyGeneration' :: StartPolicyGeneration -> PolicyGenerationDetails
$sel:cloudTrailDetails:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe CloudTrailDetails
$sel:clientToken:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudTrailDetails
cloudTrailDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PolicyGenerationDetails
policyGenerationDetails

instance Prelude.NFData StartPolicyGeneration where
  rnf :: StartPolicyGeneration -> ()
rnf StartPolicyGeneration' {Maybe Text
Maybe CloudTrailDetails
PolicyGenerationDetails
policyGenerationDetails :: PolicyGenerationDetails
cloudTrailDetails :: Maybe CloudTrailDetails
clientToken :: Maybe Text
$sel:policyGenerationDetails:StartPolicyGeneration' :: StartPolicyGeneration -> PolicyGenerationDetails
$sel:cloudTrailDetails:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe CloudTrailDetails
$sel:clientToken:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudTrailDetails
cloudTrailDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PolicyGenerationDetails
policyGenerationDetails

instance Data.ToHeaders StartPolicyGeneration where
  toHeaders :: StartPolicyGeneration -> 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 StartPolicyGeneration where
  toJSON :: StartPolicyGeneration -> Value
toJSON StartPolicyGeneration' {Maybe Text
Maybe CloudTrailDetails
PolicyGenerationDetails
policyGenerationDetails :: PolicyGenerationDetails
cloudTrailDetails :: Maybe CloudTrailDetails
clientToken :: Maybe Text
$sel:policyGenerationDetails:StartPolicyGeneration' :: StartPolicyGeneration -> PolicyGenerationDetails
$sel:cloudTrailDetails:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe CloudTrailDetails
$sel:clientToken:StartPolicyGeneration' :: StartPolicyGeneration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"cloudTrailDetails" 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 CloudTrailDetails
cloudTrailDetails,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"policyGenerationDetails"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PolicyGenerationDetails
policyGenerationDetails
              )
          ]
      )

instance Data.ToPath StartPolicyGeneration where
  toPath :: StartPolicyGeneration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/policy/generation"

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

-- | /See:/ 'newStartPolicyGenerationResponse' smart constructor.
data StartPolicyGenerationResponse = StartPolicyGenerationResponse'
  { -- | The response's http status code.
    StartPolicyGenerationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
    -- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
    -- generated policies or used with @CancelPolicyGeneration@ to cancel the
    -- policy generation request.
    StartPolicyGenerationResponse -> Text
jobId :: Prelude.Text
  }
  deriving (StartPolicyGenerationResponse
-> StartPolicyGenerationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartPolicyGenerationResponse
-> StartPolicyGenerationResponse -> Bool
$c/= :: StartPolicyGenerationResponse
-> StartPolicyGenerationResponse -> Bool
== :: StartPolicyGenerationResponse
-> StartPolicyGenerationResponse -> Bool
$c== :: StartPolicyGenerationResponse
-> StartPolicyGenerationResponse -> Bool
Prelude.Eq, ReadPrec [StartPolicyGenerationResponse]
ReadPrec StartPolicyGenerationResponse
Int -> ReadS StartPolicyGenerationResponse
ReadS [StartPolicyGenerationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartPolicyGenerationResponse]
$creadListPrec :: ReadPrec [StartPolicyGenerationResponse]
readPrec :: ReadPrec StartPolicyGenerationResponse
$creadPrec :: ReadPrec StartPolicyGenerationResponse
readList :: ReadS [StartPolicyGenerationResponse]
$creadList :: ReadS [StartPolicyGenerationResponse]
readsPrec :: Int -> ReadS StartPolicyGenerationResponse
$creadsPrec :: Int -> ReadS StartPolicyGenerationResponse
Prelude.Read, Int -> StartPolicyGenerationResponse -> ShowS
[StartPolicyGenerationResponse] -> ShowS
StartPolicyGenerationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartPolicyGenerationResponse] -> ShowS
$cshowList :: [StartPolicyGenerationResponse] -> ShowS
show :: StartPolicyGenerationResponse -> String
$cshow :: StartPolicyGenerationResponse -> String
showsPrec :: Int -> StartPolicyGenerationResponse -> ShowS
$cshowsPrec :: Int -> StartPolicyGenerationResponse -> ShowS
Prelude.Show, forall x.
Rep StartPolicyGenerationResponse x
-> StartPolicyGenerationResponse
forall x.
StartPolicyGenerationResponse
-> Rep StartPolicyGenerationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartPolicyGenerationResponse x
-> StartPolicyGenerationResponse
$cfrom :: forall x.
StartPolicyGenerationResponse
-> Rep StartPolicyGenerationResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartPolicyGenerationResponse' 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', 'startPolicyGenerationResponse_httpStatus' - The response's http status code.
--
-- 'jobId', 'startPolicyGenerationResponse_jobId' - The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
-- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
-- generated policies or used with @CancelPolicyGeneration@ to cancel the
-- policy generation request.
newStartPolicyGenerationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobId'
  Prelude.Text ->
  StartPolicyGenerationResponse
newStartPolicyGenerationResponse :: Int -> Text -> StartPolicyGenerationResponse
newStartPolicyGenerationResponse Int
pHttpStatus_ Text
pJobId_ =
  StartPolicyGenerationResponse'
    { $sel:httpStatus:StartPolicyGenerationResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:jobId:StartPolicyGenerationResponse' :: Text
jobId = Text
pJobId_
    }

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

-- | The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
-- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
-- generated policies or used with @CancelPolicyGeneration@ to cancel the
-- policy generation request.
startPolicyGenerationResponse_jobId :: Lens.Lens' StartPolicyGenerationResponse Prelude.Text
startPolicyGenerationResponse_jobId :: Lens' StartPolicyGenerationResponse Text
startPolicyGenerationResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartPolicyGenerationResponse' {Text
jobId :: Text
$sel:jobId:StartPolicyGenerationResponse' :: StartPolicyGenerationResponse -> Text
jobId} -> Text
jobId) (\s :: StartPolicyGenerationResponse
s@StartPolicyGenerationResponse' {} Text
a -> StartPolicyGenerationResponse
s {$sel:jobId:StartPolicyGenerationResponse' :: Text
jobId = Text
a} :: StartPolicyGenerationResponse)

instance Prelude.NFData StartPolicyGenerationResponse where
  rnf :: StartPolicyGenerationResponse -> ()
rnf StartPolicyGenerationResponse' {Int
Text
jobId :: Text
httpStatus :: Int
$sel:jobId:StartPolicyGenerationResponse' :: StartPolicyGenerationResponse -> Text
$sel:httpStatus:StartPolicyGenerationResponse' :: StartPolicyGenerationResponse -> 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 Text
jobId