{-# 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.ElasticBeanstalk.RetrieveEnvironmentInfo
-- 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 the compiled information from a RequestEnvironmentInfo
-- request.
--
-- Related Topics
--
-- -   RequestEnvironmentInfo
module Amazonka.ElasticBeanstalk.RetrieveEnvironmentInfo
  ( -- * Creating a Request
    RetrieveEnvironmentInfo (..),
    newRetrieveEnvironmentInfo,

    -- * Request Lenses
    retrieveEnvironmentInfo_environmentId,
    retrieveEnvironmentInfo_environmentName,
    retrieveEnvironmentInfo_infoType,

    -- * Destructuring the Response
    RetrieveEnvironmentInfoResponse (..),
    newRetrieveEnvironmentInfoResponse,

    -- * Response Lenses
    retrieveEnvironmentInfoResponse_environmentInfo,
    retrieveEnvironmentInfoResponse_httpStatus,
  )
where

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

-- | Request to download logs retrieved with RequestEnvironmentInfo.
--
-- /See:/ 'newRetrieveEnvironmentInfo' smart constructor.
data RetrieveEnvironmentInfo = RetrieveEnvironmentInfo'
  { -- | The ID of the data\'s environment.
    --
    -- If no such environment is found, returns an @InvalidParameterValue@
    -- error.
    --
    -- Condition: You must specify either this or an EnvironmentName, or both.
    -- If you do not specify either, AWS Elastic Beanstalk returns
    -- @MissingRequiredParameter@ error.
    RetrieveEnvironmentInfo -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | The name of the data\'s environment.
    --
    -- If no such environment is found, returns an @InvalidParameterValue@
    -- error.
    --
    -- Condition: You must specify either this or an EnvironmentId, or both. If
    -- you do not specify either, AWS Elastic Beanstalk returns
    -- @MissingRequiredParameter@ error.
    RetrieveEnvironmentInfo -> Maybe Text
environmentName :: Prelude.Maybe Prelude.Text,
    -- | The type of information to retrieve.
    RetrieveEnvironmentInfo -> EnvironmentInfoType
infoType :: EnvironmentInfoType
  }
  deriving (RetrieveEnvironmentInfo -> RetrieveEnvironmentInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetrieveEnvironmentInfo -> RetrieveEnvironmentInfo -> Bool
$c/= :: RetrieveEnvironmentInfo -> RetrieveEnvironmentInfo -> Bool
== :: RetrieveEnvironmentInfo -> RetrieveEnvironmentInfo -> Bool
$c== :: RetrieveEnvironmentInfo -> RetrieveEnvironmentInfo -> Bool
Prelude.Eq, ReadPrec [RetrieveEnvironmentInfo]
ReadPrec RetrieveEnvironmentInfo
Int -> ReadS RetrieveEnvironmentInfo
ReadS [RetrieveEnvironmentInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetrieveEnvironmentInfo]
$creadListPrec :: ReadPrec [RetrieveEnvironmentInfo]
readPrec :: ReadPrec RetrieveEnvironmentInfo
$creadPrec :: ReadPrec RetrieveEnvironmentInfo
readList :: ReadS [RetrieveEnvironmentInfo]
$creadList :: ReadS [RetrieveEnvironmentInfo]
readsPrec :: Int -> ReadS RetrieveEnvironmentInfo
$creadsPrec :: Int -> ReadS RetrieveEnvironmentInfo
Prelude.Read, Int -> RetrieveEnvironmentInfo -> ShowS
[RetrieveEnvironmentInfo] -> ShowS
RetrieveEnvironmentInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetrieveEnvironmentInfo] -> ShowS
$cshowList :: [RetrieveEnvironmentInfo] -> ShowS
show :: RetrieveEnvironmentInfo -> String
$cshow :: RetrieveEnvironmentInfo -> String
showsPrec :: Int -> RetrieveEnvironmentInfo -> ShowS
$cshowsPrec :: Int -> RetrieveEnvironmentInfo -> ShowS
Prelude.Show, forall x. Rep RetrieveEnvironmentInfo x -> RetrieveEnvironmentInfo
forall x. RetrieveEnvironmentInfo -> Rep RetrieveEnvironmentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetrieveEnvironmentInfo x -> RetrieveEnvironmentInfo
$cfrom :: forall x. RetrieveEnvironmentInfo -> Rep RetrieveEnvironmentInfo x
Prelude.Generic)

-- |
-- Create a value of 'RetrieveEnvironmentInfo' 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:
--
-- 'environmentId', 'retrieveEnvironmentInfo_environmentId' - The ID of the data\'s environment.
--
-- If no such environment is found, returns an @InvalidParameterValue@
-- error.
--
-- Condition: You must specify either this or an EnvironmentName, or both.
-- If you do not specify either, AWS Elastic Beanstalk returns
-- @MissingRequiredParameter@ error.
--
-- 'environmentName', 'retrieveEnvironmentInfo_environmentName' - The name of the data\'s environment.
--
-- If no such environment is found, returns an @InvalidParameterValue@
-- error.
--
-- Condition: You must specify either this or an EnvironmentId, or both. If
-- you do not specify either, AWS Elastic Beanstalk returns
-- @MissingRequiredParameter@ error.
--
-- 'infoType', 'retrieveEnvironmentInfo_infoType' - The type of information to retrieve.
newRetrieveEnvironmentInfo ::
  -- | 'infoType'
  EnvironmentInfoType ->
  RetrieveEnvironmentInfo
newRetrieveEnvironmentInfo :: EnvironmentInfoType -> RetrieveEnvironmentInfo
newRetrieveEnvironmentInfo EnvironmentInfoType
pInfoType_ =
  RetrieveEnvironmentInfo'
    { $sel:environmentId:RetrieveEnvironmentInfo' :: Maybe Text
environmentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:environmentName:RetrieveEnvironmentInfo' :: Maybe Text
environmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:infoType:RetrieveEnvironmentInfo' :: EnvironmentInfoType
infoType = EnvironmentInfoType
pInfoType_
    }

-- | The ID of the data\'s environment.
--
-- If no such environment is found, returns an @InvalidParameterValue@
-- error.
--
-- Condition: You must specify either this or an EnvironmentName, or both.
-- If you do not specify either, AWS Elastic Beanstalk returns
-- @MissingRequiredParameter@ error.
retrieveEnvironmentInfo_environmentId :: Lens.Lens' RetrieveEnvironmentInfo (Prelude.Maybe Prelude.Text)
retrieveEnvironmentInfo_environmentId :: Lens' RetrieveEnvironmentInfo (Maybe Text)
retrieveEnvironmentInfo_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetrieveEnvironmentInfo' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: RetrieveEnvironmentInfo
s@RetrieveEnvironmentInfo' {} Maybe Text
a -> RetrieveEnvironmentInfo
s {$sel:environmentId:RetrieveEnvironmentInfo' :: Maybe Text
environmentId = Maybe Text
a} :: RetrieveEnvironmentInfo)

-- | The name of the data\'s environment.
--
-- If no such environment is found, returns an @InvalidParameterValue@
-- error.
--
-- Condition: You must specify either this or an EnvironmentId, or both. If
-- you do not specify either, AWS Elastic Beanstalk returns
-- @MissingRequiredParameter@ error.
retrieveEnvironmentInfo_environmentName :: Lens.Lens' RetrieveEnvironmentInfo (Prelude.Maybe Prelude.Text)
retrieveEnvironmentInfo_environmentName :: Lens' RetrieveEnvironmentInfo (Maybe Text)
retrieveEnvironmentInfo_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetrieveEnvironmentInfo' {Maybe Text
environmentName :: Maybe Text
$sel:environmentName:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
environmentName} -> Maybe Text
environmentName) (\s :: RetrieveEnvironmentInfo
s@RetrieveEnvironmentInfo' {} Maybe Text
a -> RetrieveEnvironmentInfo
s {$sel:environmentName:RetrieveEnvironmentInfo' :: Maybe Text
environmentName = Maybe Text
a} :: RetrieveEnvironmentInfo)

-- | The type of information to retrieve.
retrieveEnvironmentInfo_infoType :: Lens.Lens' RetrieveEnvironmentInfo EnvironmentInfoType
retrieveEnvironmentInfo_infoType :: Lens' RetrieveEnvironmentInfo EnvironmentInfoType
retrieveEnvironmentInfo_infoType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetrieveEnvironmentInfo' {EnvironmentInfoType
infoType :: EnvironmentInfoType
$sel:infoType:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> EnvironmentInfoType
infoType} -> EnvironmentInfoType
infoType) (\s :: RetrieveEnvironmentInfo
s@RetrieveEnvironmentInfo' {} EnvironmentInfoType
a -> RetrieveEnvironmentInfo
s {$sel:infoType:RetrieveEnvironmentInfo' :: EnvironmentInfoType
infoType = EnvironmentInfoType
a} :: RetrieveEnvironmentInfo)

instance Core.AWSRequest RetrieveEnvironmentInfo where
  type
    AWSResponse RetrieveEnvironmentInfo =
      RetrieveEnvironmentInfoResponse
  request :: (Service -> Service)
-> RetrieveEnvironmentInfo -> Request RetrieveEnvironmentInfo
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RetrieveEnvironmentInfo
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RetrieveEnvironmentInfo)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"RetrieveEnvironmentInfoResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [EnvironmentInfoDescription]
-> Int -> RetrieveEnvironmentInfoResponse
RetrieveEnvironmentInfoResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"EnvironmentInfo"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 RetrieveEnvironmentInfo where
  hashWithSalt :: Int -> RetrieveEnvironmentInfo -> Int
hashWithSalt Int
_salt RetrieveEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
$sel:environmentId:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EnvironmentInfoType
infoType

instance Prelude.NFData RetrieveEnvironmentInfo where
  rnf :: RetrieveEnvironmentInfo -> ()
rnf RetrieveEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
$sel:environmentId:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EnvironmentInfoType
infoType

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

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

instance Data.ToQuery RetrieveEnvironmentInfo where
  toQuery :: RetrieveEnvironmentInfo -> QueryString
toQuery RetrieveEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
$sel:environmentId:RetrieveEnvironmentInfo' :: RetrieveEnvironmentInfo -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RetrieveEnvironmentInfo" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"EnvironmentId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentId,
        ByteString
"EnvironmentName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentName,
        ByteString
"InfoType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: EnvironmentInfoType
infoType
      ]

-- | Result message containing a description of the requested environment
-- info.
--
-- /See:/ 'newRetrieveEnvironmentInfoResponse' smart constructor.
data RetrieveEnvironmentInfoResponse = RetrieveEnvironmentInfoResponse'
  { -- | The EnvironmentInfoDescription of the environment.
    RetrieveEnvironmentInfoResponse
-> Maybe [EnvironmentInfoDescription]
environmentInfo :: Prelude.Maybe [EnvironmentInfoDescription],
    -- | The response's http status code.
    RetrieveEnvironmentInfoResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RetrieveEnvironmentInfoResponse
-> RetrieveEnvironmentInfoResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetrieveEnvironmentInfoResponse
-> RetrieveEnvironmentInfoResponse -> Bool
$c/= :: RetrieveEnvironmentInfoResponse
-> RetrieveEnvironmentInfoResponse -> Bool
== :: RetrieveEnvironmentInfoResponse
-> RetrieveEnvironmentInfoResponse -> Bool
$c== :: RetrieveEnvironmentInfoResponse
-> RetrieveEnvironmentInfoResponse -> Bool
Prelude.Eq, ReadPrec [RetrieveEnvironmentInfoResponse]
ReadPrec RetrieveEnvironmentInfoResponse
Int -> ReadS RetrieveEnvironmentInfoResponse
ReadS [RetrieveEnvironmentInfoResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetrieveEnvironmentInfoResponse]
$creadListPrec :: ReadPrec [RetrieveEnvironmentInfoResponse]
readPrec :: ReadPrec RetrieveEnvironmentInfoResponse
$creadPrec :: ReadPrec RetrieveEnvironmentInfoResponse
readList :: ReadS [RetrieveEnvironmentInfoResponse]
$creadList :: ReadS [RetrieveEnvironmentInfoResponse]
readsPrec :: Int -> ReadS RetrieveEnvironmentInfoResponse
$creadsPrec :: Int -> ReadS RetrieveEnvironmentInfoResponse
Prelude.Read, Int -> RetrieveEnvironmentInfoResponse -> ShowS
[RetrieveEnvironmentInfoResponse] -> ShowS
RetrieveEnvironmentInfoResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetrieveEnvironmentInfoResponse] -> ShowS
$cshowList :: [RetrieveEnvironmentInfoResponse] -> ShowS
show :: RetrieveEnvironmentInfoResponse -> String
$cshow :: RetrieveEnvironmentInfoResponse -> String
showsPrec :: Int -> RetrieveEnvironmentInfoResponse -> ShowS
$cshowsPrec :: Int -> RetrieveEnvironmentInfoResponse -> ShowS
Prelude.Show, forall x.
Rep RetrieveEnvironmentInfoResponse x
-> RetrieveEnvironmentInfoResponse
forall x.
RetrieveEnvironmentInfoResponse
-> Rep RetrieveEnvironmentInfoResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RetrieveEnvironmentInfoResponse x
-> RetrieveEnvironmentInfoResponse
$cfrom :: forall x.
RetrieveEnvironmentInfoResponse
-> Rep RetrieveEnvironmentInfoResponse x
Prelude.Generic)

-- |
-- Create a value of 'RetrieveEnvironmentInfoResponse' 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:
--
-- 'environmentInfo', 'retrieveEnvironmentInfoResponse_environmentInfo' - The EnvironmentInfoDescription of the environment.
--
-- 'httpStatus', 'retrieveEnvironmentInfoResponse_httpStatus' - The response's http status code.
newRetrieveEnvironmentInfoResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RetrieveEnvironmentInfoResponse
newRetrieveEnvironmentInfoResponse :: Int -> RetrieveEnvironmentInfoResponse
newRetrieveEnvironmentInfoResponse Int
pHttpStatus_ =
  RetrieveEnvironmentInfoResponse'
    { $sel:environmentInfo:RetrieveEnvironmentInfoResponse' :: Maybe [EnvironmentInfoDescription]
environmentInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RetrieveEnvironmentInfoResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The EnvironmentInfoDescription of the environment.
retrieveEnvironmentInfoResponse_environmentInfo :: Lens.Lens' RetrieveEnvironmentInfoResponse (Prelude.Maybe [EnvironmentInfoDescription])
retrieveEnvironmentInfoResponse_environmentInfo :: Lens'
  RetrieveEnvironmentInfoResponse
  (Maybe [EnvironmentInfoDescription])
retrieveEnvironmentInfoResponse_environmentInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetrieveEnvironmentInfoResponse' {Maybe [EnvironmentInfoDescription]
environmentInfo :: Maybe [EnvironmentInfoDescription]
$sel:environmentInfo:RetrieveEnvironmentInfoResponse' :: RetrieveEnvironmentInfoResponse
-> Maybe [EnvironmentInfoDescription]
environmentInfo} -> Maybe [EnvironmentInfoDescription]
environmentInfo) (\s :: RetrieveEnvironmentInfoResponse
s@RetrieveEnvironmentInfoResponse' {} Maybe [EnvironmentInfoDescription]
a -> RetrieveEnvironmentInfoResponse
s {$sel:environmentInfo:RetrieveEnvironmentInfoResponse' :: Maybe [EnvironmentInfoDescription]
environmentInfo = Maybe [EnvironmentInfoDescription]
a} :: RetrieveEnvironmentInfoResponse) 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.
retrieveEnvironmentInfoResponse_httpStatus :: Lens.Lens' RetrieveEnvironmentInfoResponse Prelude.Int
retrieveEnvironmentInfoResponse_httpStatus :: Lens' RetrieveEnvironmentInfoResponse Int
retrieveEnvironmentInfoResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetrieveEnvironmentInfoResponse' {Int
httpStatus :: Int
$sel:httpStatus:RetrieveEnvironmentInfoResponse' :: RetrieveEnvironmentInfoResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RetrieveEnvironmentInfoResponse
s@RetrieveEnvironmentInfoResponse' {} Int
a -> RetrieveEnvironmentInfoResponse
s {$sel:httpStatus:RetrieveEnvironmentInfoResponse' :: Int
httpStatus = Int
a} :: RetrieveEnvironmentInfoResponse)

instance
  Prelude.NFData
    RetrieveEnvironmentInfoResponse
  where
  rnf :: RetrieveEnvironmentInfoResponse -> ()
rnf RetrieveEnvironmentInfoResponse' {Int
Maybe [EnvironmentInfoDescription]
httpStatus :: Int
environmentInfo :: Maybe [EnvironmentInfoDescription]
$sel:httpStatus:RetrieveEnvironmentInfoResponse' :: RetrieveEnvironmentInfoResponse -> Int
$sel:environmentInfo:RetrieveEnvironmentInfoResponse' :: RetrieveEnvironmentInfoResponse
-> Maybe [EnvironmentInfoDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EnvironmentInfoDescription]
environmentInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus