{-# 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.Glue.BatchGetBlueprints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a list of blueprints.
module Amazonka.Glue.BatchGetBlueprints
  ( -- * Creating a Request
    BatchGetBlueprints (..),
    newBatchGetBlueprints,

    -- * Request Lenses
    batchGetBlueprints_includeBlueprint,
    batchGetBlueprints_includeParameterSpec,
    batchGetBlueprints_names,

    -- * Destructuring the Response
    BatchGetBlueprintsResponse (..),
    newBatchGetBlueprintsResponse,

    -- * Response Lenses
    batchGetBlueprintsResponse_blueprints,
    batchGetBlueprintsResponse_missingBlueprints,
    batchGetBlueprintsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newBatchGetBlueprints' smart constructor.
data BatchGetBlueprints = BatchGetBlueprints'
  { -- | Specifies whether or not to include the blueprint in the response.
    BatchGetBlueprints -> Maybe Bool
includeBlueprint :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether or not to include the parameters, as a JSON string,
    -- for the blueprint in the response.
    BatchGetBlueprints -> Maybe Bool
includeParameterSpec :: Prelude.Maybe Prelude.Bool,
    -- | A list of blueprint names.
    BatchGetBlueprints -> NonEmpty Text
names :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetBlueprints -> BatchGetBlueprints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetBlueprints -> BatchGetBlueprints -> Bool
$c/= :: BatchGetBlueprints -> BatchGetBlueprints -> Bool
== :: BatchGetBlueprints -> BatchGetBlueprints -> Bool
$c== :: BatchGetBlueprints -> BatchGetBlueprints -> Bool
Prelude.Eq, ReadPrec [BatchGetBlueprints]
ReadPrec BatchGetBlueprints
Int -> ReadS BatchGetBlueprints
ReadS [BatchGetBlueprints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetBlueprints]
$creadListPrec :: ReadPrec [BatchGetBlueprints]
readPrec :: ReadPrec BatchGetBlueprints
$creadPrec :: ReadPrec BatchGetBlueprints
readList :: ReadS [BatchGetBlueprints]
$creadList :: ReadS [BatchGetBlueprints]
readsPrec :: Int -> ReadS BatchGetBlueprints
$creadsPrec :: Int -> ReadS BatchGetBlueprints
Prelude.Read, Int -> BatchGetBlueprints -> ShowS
[BatchGetBlueprints] -> ShowS
BatchGetBlueprints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetBlueprints] -> ShowS
$cshowList :: [BatchGetBlueprints] -> ShowS
show :: BatchGetBlueprints -> String
$cshow :: BatchGetBlueprints -> String
showsPrec :: Int -> BatchGetBlueprints -> ShowS
$cshowsPrec :: Int -> BatchGetBlueprints -> ShowS
Prelude.Show, forall x. Rep BatchGetBlueprints x -> BatchGetBlueprints
forall x. BatchGetBlueprints -> Rep BatchGetBlueprints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetBlueprints x -> BatchGetBlueprints
$cfrom :: forall x. BatchGetBlueprints -> Rep BatchGetBlueprints x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetBlueprints' 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:
--
-- 'includeBlueprint', 'batchGetBlueprints_includeBlueprint' - Specifies whether or not to include the blueprint in the response.
--
-- 'includeParameterSpec', 'batchGetBlueprints_includeParameterSpec' - Specifies whether or not to include the parameters, as a JSON string,
-- for the blueprint in the response.
--
-- 'names', 'batchGetBlueprints_names' - A list of blueprint names.
newBatchGetBlueprints ::
  -- | 'names'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetBlueprints
newBatchGetBlueprints :: NonEmpty Text -> BatchGetBlueprints
newBatchGetBlueprints NonEmpty Text
pNames_ =
  BatchGetBlueprints'
    { $sel:includeBlueprint:BatchGetBlueprints' :: Maybe Bool
includeBlueprint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:includeParameterSpec:BatchGetBlueprints' :: Maybe Bool
includeParameterSpec = forall a. Maybe a
Prelude.Nothing,
      $sel:names:BatchGetBlueprints' :: NonEmpty Text
names = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pNames_
    }

-- | Specifies whether or not to include the blueprint in the response.
batchGetBlueprints_includeBlueprint :: Lens.Lens' BatchGetBlueprints (Prelude.Maybe Prelude.Bool)
batchGetBlueprints_includeBlueprint :: Lens' BatchGetBlueprints (Maybe Bool)
batchGetBlueprints_includeBlueprint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprints' {Maybe Bool
includeBlueprint :: Maybe Bool
$sel:includeBlueprint:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
includeBlueprint} -> Maybe Bool
includeBlueprint) (\s :: BatchGetBlueprints
s@BatchGetBlueprints' {} Maybe Bool
a -> BatchGetBlueprints
s {$sel:includeBlueprint:BatchGetBlueprints' :: Maybe Bool
includeBlueprint = Maybe Bool
a} :: BatchGetBlueprints)

-- | Specifies whether or not to include the parameters, as a JSON string,
-- for the blueprint in the response.
batchGetBlueprints_includeParameterSpec :: Lens.Lens' BatchGetBlueprints (Prelude.Maybe Prelude.Bool)
batchGetBlueprints_includeParameterSpec :: Lens' BatchGetBlueprints (Maybe Bool)
batchGetBlueprints_includeParameterSpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprints' {Maybe Bool
includeParameterSpec :: Maybe Bool
$sel:includeParameterSpec:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
includeParameterSpec} -> Maybe Bool
includeParameterSpec) (\s :: BatchGetBlueprints
s@BatchGetBlueprints' {} Maybe Bool
a -> BatchGetBlueprints
s {$sel:includeParameterSpec:BatchGetBlueprints' :: Maybe Bool
includeParameterSpec = Maybe Bool
a} :: BatchGetBlueprints)

-- | A list of blueprint names.
batchGetBlueprints_names :: Lens.Lens' BatchGetBlueprints (Prelude.NonEmpty Prelude.Text)
batchGetBlueprints_names :: Lens' BatchGetBlueprints (NonEmpty Text)
batchGetBlueprints_names = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprints' {NonEmpty Text
names :: NonEmpty Text
$sel:names:BatchGetBlueprints' :: BatchGetBlueprints -> NonEmpty Text
names} -> NonEmpty Text
names) (\s :: BatchGetBlueprints
s@BatchGetBlueprints' {} NonEmpty Text
a -> BatchGetBlueprints
s {$sel:names:BatchGetBlueprints' :: NonEmpty Text
names = NonEmpty Text
a} :: BatchGetBlueprints) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchGetBlueprints where
  type
    AWSResponse BatchGetBlueprints =
      BatchGetBlueprintsResponse
  request :: (Service -> Service)
-> BatchGetBlueprints -> Request BatchGetBlueprints
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 BatchGetBlueprints
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetBlueprints)))
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 [Blueprint]
-> Maybe [Text] -> Int -> BatchGetBlueprintsResponse
BatchGetBlueprintsResponse'
            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
"Blueprints" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"MissingBlueprints"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 BatchGetBlueprints where
  hashWithSalt :: Int -> BatchGetBlueprints -> Int
hashWithSalt Int
_salt BatchGetBlueprints' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeParameterSpec :: Maybe Bool
includeBlueprint :: Maybe Bool
$sel:names:BatchGetBlueprints' :: BatchGetBlueprints -> NonEmpty Text
$sel:includeParameterSpec:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
$sel:includeBlueprint:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeBlueprint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeParameterSpec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
names

instance Prelude.NFData BatchGetBlueprints where
  rnf :: BatchGetBlueprints -> ()
rnf BatchGetBlueprints' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeParameterSpec :: Maybe Bool
includeBlueprint :: Maybe Bool
$sel:names:BatchGetBlueprints' :: BatchGetBlueprints -> NonEmpty Text
$sel:includeParameterSpec:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
$sel:includeBlueprint:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeBlueprint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeParameterSpec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
names

instance Data.ToHeaders BatchGetBlueprints where
  toHeaders :: BatchGetBlueprints -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AWSGlue.BatchGetBlueprints" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON BatchGetBlueprints where
  toJSON :: BatchGetBlueprints -> Value
toJSON BatchGetBlueprints' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeParameterSpec :: Maybe Bool
includeBlueprint :: Maybe Bool
$sel:names:BatchGetBlueprints' :: BatchGetBlueprints -> NonEmpty Text
$sel:includeParameterSpec:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
$sel:includeBlueprint:BatchGetBlueprints' :: BatchGetBlueprints -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IncludeBlueprint" 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 Bool
includeBlueprint,
            (Key
"IncludeParameterSpec" 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 Bool
includeParameterSpec,
            forall a. a -> Maybe a
Prelude.Just (Key
"Names" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
names)
          ]
      )

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

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

-- | /See:/ 'newBatchGetBlueprintsResponse' smart constructor.
data BatchGetBlueprintsResponse = BatchGetBlueprintsResponse'
  { -- | Returns a list of blueprint as a @Blueprints@ object.
    BatchGetBlueprintsResponse -> Maybe [Blueprint]
blueprints :: Prelude.Maybe [Blueprint],
    -- | Returns a list of @BlueprintNames@ that were not found.
    BatchGetBlueprintsResponse -> Maybe [Text]
missingBlueprints :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    BatchGetBlueprintsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetBlueprintsResponse -> BatchGetBlueprintsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetBlueprintsResponse -> BatchGetBlueprintsResponse -> Bool
$c/= :: BatchGetBlueprintsResponse -> BatchGetBlueprintsResponse -> Bool
== :: BatchGetBlueprintsResponse -> BatchGetBlueprintsResponse -> Bool
$c== :: BatchGetBlueprintsResponse -> BatchGetBlueprintsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetBlueprintsResponse]
ReadPrec BatchGetBlueprintsResponse
Int -> ReadS BatchGetBlueprintsResponse
ReadS [BatchGetBlueprintsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetBlueprintsResponse]
$creadListPrec :: ReadPrec [BatchGetBlueprintsResponse]
readPrec :: ReadPrec BatchGetBlueprintsResponse
$creadPrec :: ReadPrec BatchGetBlueprintsResponse
readList :: ReadS [BatchGetBlueprintsResponse]
$creadList :: ReadS [BatchGetBlueprintsResponse]
readsPrec :: Int -> ReadS BatchGetBlueprintsResponse
$creadsPrec :: Int -> ReadS BatchGetBlueprintsResponse
Prelude.Read, Int -> BatchGetBlueprintsResponse -> ShowS
[BatchGetBlueprintsResponse] -> ShowS
BatchGetBlueprintsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetBlueprintsResponse] -> ShowS
$cshowList :: [BatchGetBlueprintsResponse] -> ShowS
show :: BatchGetBlueprintsResponse -> String
$cshow :: BatchGetBlueprintsResponse -> String
showsPrec :: Int -> BatchGetBlueprintsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetBlueprintsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetBlueprintsResponse x -> BatchGetBlueprintsResponse
forall x.
BatchGetBlueprintsResponse -> Rep BatchGetBlueprintsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetBlueprintsResponse x -> BatchGetBlueprintsResponse
$cfrom :: forall x.
BatchGetBlueprintsResponse -> Rep BatchGetBlueprintsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetBlueprintsResponse' 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:
--
-- 'blueprints', 'batchGetBlueprintsResponse_blueprints' - Returns a list of blueprint as a @Blueprints@ object.
--
-- 'missingBlueprints', 'batchGetBlueprintsResponse_missingBlueprints' - Returns a list of @BlueprintNames@ that were not found.
--
-- 'httpStatus', 'batchGetBlueprintsResponse_httpStatus' - The response's http status code.
newBatchGetBlueprintsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetBlueprintsResponse
newBatchGetBlueprintsResponse :: Int -> BatchGetBlueprintsResponse
newBatchGetBlueprintsResponse Int
pHttpStatus_ =
  BatchGetBlueprintsResponse'
    { $sel:blueprints:BatchGetBlueprintsResponse' :: Maybe [Blueprint]
blueprints =
        forall a. Maybe a
Prelude.Nothing,
      $sel:missingBlueprints:BatchGetBlueprintsResponse' :: Maybe [Text]
missingBlueprints = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetBlueprintsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns a list of blueprint as a @Blueprints@ object.
batchGetBlueprintsResponse_blueprints :: Lens.Lens' BatchGetBlueprintsResponse (Prelude.Maybe [Blueprint])
batchGetBlueprintsResponse_blueprints :: Lens' BatchGetBlueprintsResponse (Maybe [Blueprint])
batchGetBlueprintsResponse_blueprints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprintsResponse' {Maybe [Blueprint]
blueprints :: Maybe [Blueprint]
$sel:blueprints:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Maybe [Blueprint]
blueprints} -> Maybe [Blueprint]
blueprints) (\s :: BatchGetBlueprintsResponse
s@BatchGetBlueprintsResponse' {} Maybe [Blueprint]
a -> BatchGetBlueprintsResponse
s {$sel:blueprints:BatchGetBlueprintsResponse' :: Maybe [Blueprint]
blueprints = Maybe [Blueprint]
a} :: BatchGetBlueprintsResponse) 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

-- | Returns a list of @BlueprintNames@ that were not found.
batchGetBlueprintsResponse_missingBlueprints :: Lens.Lens' BatchGetBlueprintsResponse (Prelude.Maybe [Prelude.Text])
batchGetBlueprintsResponse_missingBlueprints :: Lens' BatchGetBlueprintsResponse (Maybe [Text])
batchGetBlueprintsResponse_missingBlueprints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprintsResponse' {Maybe [Text]
missingBlueprints :: Maybe [Text]
$sel:missingBlueprints:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Maybe [Text]
missingBlueprints} -> Maybe [Text]
missingBlueprints) (\s :: BatchGetBlueprintsResponse
s@BatchGetBlueprintsResponse' {} Maybe [Text]
a -> BatchGetBlueprintsResponse
s {$sel:missingBlueprints:BatchGetBlueprintsResponse' :: Maybe [Text]
missingBlueprints = Maybe [Text]
a} :: BatchGetBlueprintsResponse) 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 response's http status code.
batchGetBlueprintsResponse_httpStatus :: Lens.Lens' BatchGetBlueprintsResponse Prelude.Int
batchGetBlueprintsResponse_httpStatus :: Lens' BatchGetBlueprintsResponse Int
batchGetBlueprintsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBlueprintsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetBlueprintsResponse
s@BatchGetBlueprintsResponse' {} Int
a -> BatchGetBlueprintsResponse
s {$sel:httpStatus:BatchGetBlueprintsResponse' :: Int
httpStatus = Int
a} :: BatchGetBlueprintsResponse)

instance Prelude.NFData BatchGetBlueprintsResponse where
  rnf :: BatchGetBlueprintsResponse -> ()
rnf BatchGetBlueprintsResponse' {Int
Maybe [Text]
Maybe [Blueprint]
httpStatus :: Int
missingBlueprints :: Maybe [Text]
blueprints :: Maybe [Blueprint]
$sel:httpStatus:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Int
$sel:missingBlueprints:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Maybe [Text]
$sel:blueprints:BatchGetBlueprintsResponse' :: BatchGetBlueprintsResponse -> Maybe [Blueprint]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Blueprint]
blueprints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
missingBlueprints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus