{-# 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.CodeDeploy.BatchGetApplicationRevisions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about one or more application revisions. The maximum
-- number of application revisions that can be returned is 25.
module Amazonka.CodeDeploy.BatchGetApplicationRevisions
  ( -- * Creating a Request
    BatchGetApplicationRevisions (..),
    newBatchGetApplicationRevisions,

    -- * Request Lenses
    batchGetApplicationRevisions_applicationName,
    batchGetApplicationRevisions_revisions,

    -- * Destructuring the Response
    BatchGetApplicationRevisionsResponse (..),
    newBatchGetApplicationRevisionsResponse,

    -- * Response Lenses
    batchGetApplicationRevisionsResponse_applicationName,
    batchGetApplicationRevisionsResponse_errorMessage,
    batchGetApplicationRevisionsResponse_revisions,
    batchGetApplicationRevisionsResponse_httpStatus,
  )
where

import Amazonka.CodeDeploy.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

-- | Represents the input of a @BatchGetApplicationRevisions@ operation.
--
-- /See:/ 'newBatchGetApplicationRevisions' smart constructor.
data BatchGetApplicationRevisions = BatchGetApplicationRevisions'
  { -- | The name of an CodeDeploy application about which to get revision
    -- information.
    BatchGetApplicationRevisions -> Text
applicationName :: Prelude.Text,
    -- | An array of @RevisionLocation@ objects that specify information to get
    -- about the application revisions, including type and location. The
    -- maximum number of @RevisionLocation@ objects you can specify is 25.
    BatchGetApplicationRevisions -> [RevisionLocation]
revisions :: [RevisionLocation]
  }
  deriving (BatchGetApplicationRevisions
-> BatchGetApplicationRevisions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetApplicationRevisions
-> BatchGetApplicationRevisions -> Bool
$c/= :: BatchGetApplicationRevisions
-> BatchGetApplicationRevisions -> Bool
== :: BatchGetApplicationRevisions
-> BatchGetApplicationRevisions -> Bool
$c== :: BatchGetApplicationRevisions
-> BatchGetApplicationRevisions -> Bool
Prelude.Eq, ReadPrec [BatchGetApplicationRevisions]
ReadPrec BatchGetApplicationRevisions
Int -> ReadS BatchGetApplicationRevisions
ReadS [BatchGetApplicationRevisions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetApplicationRevisions]
$creadListPrec :: ReadPrec [BatchGetApplicationRevisions]
readPrec :: ReadPrec BatchGetApplicationRevisions
$creadPrec :: ReadPrec BatchGetApplicationRevisions
readList :: ReadS [BatchGetApplicationRevisions]
$creadList :: ReadS [BatchGetApplicationRevisions]
readsPrec :: Int -> ReadS BatchGetApplicationRevisions
$creadsPrec :: Int -> ReadS BatchGetApplicationRevisions
Prelude.Read, Int -> BatchGetApplicationRevisions -> ShowS
[BatchGetApplicationRevisions] -> ShowS
BatchGetApplicationRevisions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetApplicationRevisions] -> ShowS
$cshowList :: [BatchGetApplicationRevisions] -> ShowS
show :: BatchGetApplicationRevisions -> String
$cshow :: BatchGetApplicationRevisions -> String
showsPrec :: Int -> BatchGetApplicationRevisions -> ShowS
$cshowsPrec :: Int -> BatchGetApplicationRevisions -> ShowS
Prelude.Show, forall x.
Rep BatchGetApplicationRevisions x -> BatchGetApplicationRevisions
forall x.
BatchGetApplicationRevisions -> Rep BatchGetApplicationRevisions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetApplicationRevisions x -> BatchGetApplicationRevisions
$cfrom :: forall x.
BatchGetApplicationRevisions -> Rep BatchGetApplicationRevisions x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetApplicationRevisions' 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:
--
-- 'applicationName', 'batchGetApplicationRevisions_applicationName' - The name of an CodeDeploy application about which to get revision
-- information.
--
-- 'revisions', 'batchGetApplicationRevisions_revisions' - An array of @RevisionLocation@ objects that specify information to get
-- about the application revisions, including type and location. The
-- maximum number of @RevisionLocation@ objects you can specify is 25.
newBatchGetApplicationRevisions ::
  -- | 'applicationName'
  Prelude.Text ->
  BatchGetApplicationRevisions
newBatchGetApplicationRevisions :: Text -> BatchGetApplicationRevisions
newBatchGetApplicationRevisions Text
pApplicationName_ =
  BatchGetApplicationRevisions'
    { $sel:applicationName:BatchGetApplicationRevisions' :: Text
applicationName =
        Text
pApplicationName_,
      $sel:revisions:BatchGetApplicationRevisions' :: [RevisionLocation]
revisions = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of an CodeDeploy application about which to get revision
-- information.
batchGetApplicationRevisions_applicationName :: Lens.Lens' BatchGetApplicationRevisions Prelude.Text
batchGetApplicationRevisions_applicationName :: Lens' BatchGetApplicationRevisions Text
batchGetApplicationRevisions_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisions' {Text
applicationName :: Text
$sel:applicationName:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> Text
applicationName} -> Text
applicationName) (\s :: BatchGetApplicationRevisions
s@BatchGetApplicationRevisions' {} Text
a -> BatchGetApplicationRevisions
s {$sel:applicationName:BatchGetApplicationRevisions' :: Text
applicationName = Text
a} :: BatchGetApplicationRevisions)

-- | An array of @RevisionLocation@ objects that specify information to get
-- about the application revisions, including type and location. The
-- maximum number of @RevisionLocation@ objects you can specify is 25.
batchGetApplicationRevisions_revisions :: Lens.Lens' BatchGetApplicationRevisions [RevisionLocation]
batchGetApplicationRevisions_revisions :: Lens' BatchGetApplicationRevisions [RevisionLocation]
batchGetApplicationRevisions_revisions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisions' {[RevisionLocation]
revisions :: [RevisionLocation]
$sel:revisions:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> [RevisionLocation]
revisions} -> [RevisionLocation]
revisions) (\s :: BatchGetApplicationRevisions
s@BatchGetApplicationRevisions' {} [RevisionLocation]
a -> BatchGetApplicationRevisions
s {$sel:revisions:BatchGetApplicationRevisions' :: [RevisionLocation]
revisions = [RevisionLocation]
a} :: BatchGetApplicationRevisions) 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 BatchGetApplicationRevisions where
  type
    AWSResponse BatchGetApplicationRevisions =
      BatchGetApplicationRevisionsResponse
  request :: (Service -> Service)
-> BatchGetApplicationRevisions
-> Request BatchGetApplicationRevisions
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 BatchGetApplicationRevisions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetApplicationRevisions)))
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 [RevisionInfo]
-> Int
-> BatchGetApplicationRevisionsResponse
BatchGetApplicationRevisionsResponse'
            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
"applicationName")
            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
"errorMessage")
            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
"revisions" 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
    BatchGetApplicationRevisions
  where
  hashWithSalt :: Int -> BatchGetApplicationRevisions -> Int
hashWithSalt Int
_salt BatchGetApplicationRevisions' {[RevisionLocation]
Text
revisions :: [RevisionLocation]
applicationName :: Text
$sel:revisions:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> [RevisionLocation]
$sel:applicationName:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [RevisionLocation]
revisions

instance Prelude.NFData BatchGetApplicationRevisions where
  rnf :: BatchGetApplicationRevisions -> ()
rnf BatchGetApplicationRevisions' {[RevisionLocation]
Text
revisions :: [RevisionLocation]
applicationName :: Text
$sel:revisions:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> [RevisionLocation]
$sel:applicationName:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [RevisionLocation]
revisions

instance Data.ToHeaders BatchGetApplicationRevisions where
  toHeaders :: BatchGetApplicationRevisions -> 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
"CodeDeploy_20141006.BatchGetApplicationRevisions" ::
                          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 BatchGetApplicationRevisions where
  toJSON :: BatchGetApplicationRevisions -> Value
toJSON BatchGetApplicationRevisions' {[RevisionLocation]
Text
revisions :: [RevisionLocation]
applicationName :: Text
$sel:revisions:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> [RevisionLocation]
$sel:applicationName:BatchGetApplicationRevisions' :: BatchGetApplicationRevisions -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just (Key
"revisions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [RevisionLocation]
revisions)
          ]
      )

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

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

-- | Represents the output of a @BatchGetApplicationRevisions@ operation.
--
-- /See:/ 'newBatchGetApplicationRevisionsResponse' smart constructor.
data BatchGetApplicationRevisionsResponse = BatchGetApplicationRevisionsResponse'
  { -- | The name of the application that corresponds to the revisions.
    BatchGetApplicationRevisionsResponse -> Maybe Text
applicationName :: Prelude.Maybe Prelude.Text,
    -- | Information about errors that might have occurred during the API call.
    BatchGetApplicationRevisionsResponse -> Maybe Text
errorMessage :: Prelude.Maybe Prelude.Text,
    -- | Additional information about the revisions, including the type and
    -- location.
    BatchGetApplicationRevisionsResponse -> Maybe [RevisionInfo]
revisions :: Prelude.Maybe [RevisionInfo],
    -- | The response's http status code.
    BatchGetApplicationRevisionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetApplicationRevisionsResponse
-> BatchGetApplicationRevisionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetApplicationRevisionsResponse
-> BatchGetApplicationRevisionsResponse -> Bool
$c/= :: BatchGetApplicationRevisionsResponse
-> BatchGetApplicationRevisionsResponse -> Bool
== :: BatchGetApplicationRevisionsResponse
-> BatchGetApplicationRevisionsResponse -> Bool
$c== :: BatchGetApplicationRevisionsResponse
-> BatchGetApplicationRevisionsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetApplicationRevisionsResponse]
ReadPrec BatchGetApplicationRevisionsResponse
Int -> ReadS BatchGetApplicationRevisionsResponse
ReadS [BatchGetApplicationRevisionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetApplicationRevisionsResponse]
$creadListPrec :: ReadPrec [BatchGetApplicationRevisionsResponse]
readPrec :: ReadPrec BatchGetApplicationRevisionsResponse
$creadPrec :: ReadPrec BatchGetApplicationRevisionsResponse
readList :: ReadS [BatchGetApplicationRevisionsResponse]
$creadList :: ReadS [BatchGetApplicationRevisionsResponse]
readsPrec :: Int -> ReadS BatchGetApplicationRevisionsResponse
$creadsPrec :: Int -> ReadS BatchGetApplicationRevisionsResponse
Prelude.Read, Int -> BatchGetApplicationRevisionsResponse -> ShowS
[BatchGetApplicationRevisionsResponse] -> ShowS
BatchGetApplicationRevisionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetApplicationRevisionsResponse] -> ShowS
$cshowList :: [BatchGetApplicationRevisionsResponse] -> ShowS
show :: BatchGetApplicationRevisionsResponse -> String
$cshow :: BatchGetApplicationRevisionsResponse -> String
showsPrec :: Int -> BatchGetApplicationRevisionsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetApplicationRevisionsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetApplicationRevisionsResponse x
-> BatchGetApplicationRevisionsResponse
forall x.
BatchGetApplicationRevisionsResponse
-> Rep BatchGetApplicationRevisionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetApplicationRevisionsResponse x
-> BatchGetApplicationRevisionsResponse
$cfrom :: forall x.
BatchGetApplicationRevisionsResponse
-> Rep BatchGetApplicationRevisionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetApplicationRevisionsResponse' 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:
--
-- 'applicationName', 'batchGetApplicationRevisionsResponse_applicationName' - The name of the application that corresponds to the revisions.
--
-- 'errorMessage', 'batchGetApplicationRevisionsResponse_errorMessage' - Information about errors that might have occurred during the API call.
--
-- 'revisions', 'batchGetApplicationRevisionsResponse_revisions' - Additional information about the revisions, including the type and
-- location.
--
-- 'httpStatus', 'batchGetApplicationRevisionsResponse_httpStatus' - The response's http status code.
newBatchGetApplicationRevisionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetApplicationRevisionsResponse
newBatchGetApplicationRevisionsResponse :: Int -> BatchGetApplicationRevisionsResponse
newBatchGetApplicationRevisionsResponse Int
pHttpStatus_ =
  BatchGetApplicationRevisionsResponse'
    { $sel:applicationName:BatchGetApplicationRevisionsResponse' :: Maybe Text
applicationName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errorMessage:BatchGetApplicationRevisionsResponse' :: Maybe Text
errorMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:revisions:BatchGetApplicationRevisionsResponse' :: Maybe [RevisionInfo]
revisions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetApplicationRevisionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the application that corresponds to the revisions.
batchGetApplicationRevisionsResponse_applicationName :: Lens.Lens' BatchGetApplicationRevisionsResponse (Prelude.Maybe Prelude.Text)
batchGetApplicationRevisionsResponse_applicationName :: Lens' BatchGetApplicationRevisionsResponse (Maybe Text)
batchGetApplicationRevisionsResponse_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisionsResponse' {Maybe Text
applicationName :: Maybe Text
$sel:applicationName:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe Text
applicationName} -> Maybe Text
applicationName) (\s :: BatchGetApplicationRevisionsResponse
s@BatchGetApplicationRevisionsResponse' {} Maybe Text
a -> BatchGetApplicationRevisionsResponse
s {$sel:applicationName:BatchGetApplicationRevisionsResponse' :: Maybe Text
applicationName = Maybe Text
a} :: BatchGetApplicationRevisionsResponse)

-- | Information about errors that might have occurred during the API call.
batchGetApplicationRevisionsResponse_errorMessage :: Lens.Lens' BatchGetApplicationRevisionsResponse (Prelude.Maybe Prelude.Text)
batchGetApplicationRevisionsResponse_errorMessage :: Lens' BatchGetApplicationRevisionsResponse (Maybe Text)
batchGetApplicationRevisionsResponse_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisionsResponse' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: BatchGetApplicationRevisionsResponse
s@BatchGetApplicationRevisionsResponse' {} Maybe Text
a -> BatchGetApplicationRevisionsResponse
s {$sel:errorMessage:BatchGetApplicationRevisionsResponse' :: Maybe Text
errorMessage = Maybe Text
a} :: BatchGetApplicationRevisionsResponse)

-- | Additional information about the revisions, including the type and
-- location.
batchGetApplicationRevisionsResponse_revisions :: Lens.Lens' BatchGetApplicationRevisionsResponse (Prelude.Maybe [RevisionInfo])
batchGetApplicationRevisionsResponse_revisions :: Lens' BatchGetApplicationRevisionsResponse (Maybe [RevisionInfo])
batchGetApplicationRevisionsResponse_revisions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisionsResponse' {Maybe [RevisionInfo]
revisions :: Maybe [RevisionInfo]
$sel:revisions:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe [RevisionInfo]
revisions} -> Maybe [RevisionInfo]
revisions) (\s :: BatchGetApplicationRevisionsResponse
s@BatchGetApplicationRevisionsResponse' {} Maybe [RevisionInfo]
a -> BatchGetApplicationRevisionsResponse
s {$sel:revisions:BatchGetApplicationRevisionsResponse' :: Maybe [RevisionInfo]
revisions = Maybe [RevisionInfo]
a} :: BatchGetApplicationRevisionsResponse) 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.
batchGetApplicationRevisionsResponse_httpStatus :: Lens.Lens' BatchGetApplicationRevisionsResponse Prelude.Int
batchGetApplicationRevisionsResponse_httpStatus :: Lens' BatchGetApplicationRevisionsResponse Int
batchGetApplicationRevisionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetApplicationRevisionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetApplicationRevisionsResponse
s@BatchGetApplicationRevisionsResponse' {} Int
a -> BatchGetApplicationRevisionsResponse
s {$sel:httpStatus:BatchGetApplicationRevisionsResponse' :: Int
httpStatus = Int
a} :: BatchGetApplicationRevisionsResponse)

instance
  Prelude.NFData
    BatchGetApplicationRevisionsResponse
  where
  rnf :: BatchGetApplicationRevisionsResponse -> ()
rnf BatchGetApplicationRevisionsResponse' {Int
Maybe [RevisionInfo]
Maybe Text
httpStatus :: Int
revisions :: Maybe [RevisionInfo]
errorMessage :: Maybe Text
applicationName :: Maybe Text
$sel:httpStatus:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Int
$sel:revisions:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe [RevisionInfo]
$sel:errorMessage:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe Text
$sel:applicationName:BatchGetApplicationRevisionsResponse' :: BatchGetApplicationRevisionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RevisionInfo]
revisions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus