{-# 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.RequestEnvironmentInfo
-- 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 request to compile the specified type of information of the
-- deployed environment.
--
-- Setting the @InfoType@ to @tail@ compiles the last lines from the
-- application server log files of every Amazon EC2 instance in your
-- environment.
--
-- Setting the @InfoType@ to @bundle@ compresses the application server log
-- files for every Amazon EC2 instance into a @.zip@ file. Legacy and .NET
-- containers do not support bundle logs.
--
-- Use RetrieveEnvironmentInfo to obtain the set of logs.
--
-- Related Topics
--
-- -   RetrieveEnvironmentInfo
module Amazonka.ElasticBeanstalk.RequestEnvironmentInfo
  ( -- * Creating a Request
    RequestEnvironmentInfo (..),
    newRequestEnvironmentInfo,

    -- * Request Lenses
    requestEnvironmentInfo_environmentId,
    requestEnvironmentInfo_environmentName,
    requestEnvironmentInfo_infoType,

    -- * Destructuring the Response
    RequestEnvironmentInfoResponse (..),
    newRequestEnvironmentInfoResponse,
  )
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 retrieve logs from an environment and store them in your
-- Elastic Beanstalk storage bucket.
--
-- /See:/ 'newRequestEnvironmentInfo' smart constructor.
data RequestEnvironmentInfo = RequestEnvironmentInfo'
  { -- | The ID of the environment of the requested data.
    --
    -- If no such environment is found, @RequestEnvironmentInfo@ 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.
    RequestEnvironmentInfo -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | The name of the environment of the requested data.
    --
    -- If no such environment is found, @RequestEnvironmentInfo@ 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.
    RequestEnvironmentInfo -> Maybe Text
environmentName :: Prelude.Maybe Prelude.Text,
    -- | The type of information to request.
    RequestEnvironmentInfo -> EnvironmentInfoType
infoType :: EnvironmentInfoType
  }
  deriving (RequestEnvironmentInfo -> RequestEnvironmentInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestEnvironmentInfo -> RequestEnvironmentInfo -> Bool
$c/= :: RequestEnvironmentInfo -> RequestEnvironmentInfo -> Bool
== :: RequestEnvironmentInfo -> RequestEnvironmentInfo -> Bool
$c== :: RequestEnvironmentInfo -> RequestEnvironmentInfo -> Bool
Prelude.Eq, ReadPrec [RequestEnvironmentInfo]
ReadPrec RequestEnvironmentInfo
Int -> ReadS RequestEnvironmentInfo
ReadS [RequestEnvironmentInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestEnvironmentInfo]
$creadListPrec :: ReadPrec [RequestEnvironmentInfo]
readPrec :: ReadPrec RequestEnvironmentInfo
$creadPrec :: ReadPrec RequestEnvironmentInfo
readList :: ReadS [RequestEnvironmentInfo]
$creadList :: ReadS [RequestEnvironmentInfo]
readsPrec :: Int -> ReadS RequestEnvironmentInfo
$creadsPrec :: Int -> ReadS RequestEnvironmentInfo
Prelude.Read, Int -> RequestEnvironmentInfo -> ShowS
[RequestEnvironmentInfo] -> ShowS
RequestEnvironmentInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestEnvironmentInfo] -> ShowS
$cshowList :: [RequestEnvironmentInfo] -> ShowS
show :: RequestEnvironmentInfo -> String
$cshow :: RequestEnvironmentInfo -> String
showsPrec :: Int -> RequestEnvironmentInfo -> ShowS
$cshowsPrec :: Int -> RequestEnvironmentInfo -> ShowS
Prelude.Show, forall x. Rep RequestEnvironmentInfo x -> RequestEnvironmentInfo
forall x. RequestEnvironmentInfo -> Rep RequestEnvironmentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestEnvironmentInfo x -> RequestEnvironmentInfo
$cfrom :: forall x. RequestEnvironmentInfo -> Rep RequestEnvironmentInfo x
Prelude.Generic)

-- |
-- Create a value of 'RequestEnvironmentInfo' 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', 'requestEnvironmentInfo_environmentId' - The ID of the environment of the requested data.
--
-- If no such environment is found, @RequestEnvironmentInfo@ 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', 'requestEnvironmentInfo_environmentName' - The name of the environment of the requested data.
--
-- If no such environment is found, @RequestEnvironmentInfo@ 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', 'requestEnvironmentInfo_infoType' - The type of information to request.
newRequestEnvironmentInfo ::
  -- | 'infoType'
  EnvironmentInfoType ->
  RequestEnvironmentInfo
newRequestEnvironmentInfo :: EnvironmentInfoType -> RequestEnvironmentInfo
newRequestEnvironmentInfo EnvironmentInfoType
pInfoType_ =
  RequestEnvironmentInfo'
    { $sel:environmentId:RequestEnvironmentInfo' :: Maybe Text
environmentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:environmentName:RequestEnvironmentInfo' :: Maybe Text
environmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:infoType:RequestEnvironmentInfo' :: EnvironmentInfoType
infoType = EnvironmentInfoType
pInfoType_
    }

-- | The ID of the environment of the requested data.
--
-- If no such environment is found, @RequestEnvironmentInfo@ 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.
requestEnvironmentInfo_environmentId :: Lens.Lens' RequestEnvironmentInfo (Prelude.Maybe Prelude.Text)
requestEnvironmentInfo_environmentId :: Lens' RequestEnvironmentInfo (Maybe Text)
requestEnvironmentInfo_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestEnvironmentInfo' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: RequestEnvironmentInfo
s@RequestEnvironmentInfo' {} Maybe Text
a -> RequestEnvironmentInfo
s {$sel:environmentId:RequestEnvironmentInfo' :: Maybe Text
environmentId = Maybe Text
a} :: RequestEnvironmentInfo)

-- | The name of the environment of the requested data.
--
-- If no such environment is found, @RequestEnvironmentInfo@ 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.
requestEnvironmentInfo_environmentName :: Lens.Lens' RequestEnvironmentInfo (Prelude.Maybe Prelude.Text)
requestEnvironmentInfo_environmentName :: Lens' RequestEnvironmentInfo (Maybe Text)
requestEnvironmentInfo_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestEnvironmentInfo' {Maybe Text
environmentName :: Maybe Text
$sel:environmentName:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
environmentName} -> Maybe Text
environmentName) (\s :: RequestEnvironmentInfo
s@RequestEnvironmentInfo' {} Maybe Text
a -> RequestEnvironmentInfo
s {$sel:environmentName:RequestEnvironmentInfo' :: Maybe Text
environmentName = Maybe Text
a} :: RequestEnvironmentInfo)

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

instance Core.AWSRequest RequestEnvironmentInfo where
  type
    AWSResponse RequestEnvironmentInfo =
      RequestEnvironmentInfoResponse
  request :: (Service -> Service)
-> RequestEnvironmentInfo -> Request RequestEnvironmentInfo
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 RequestEnvironmentInfo
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RequestEnvironmentInfo)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      RequestEnvironmentInfoResponse
RequestEnvironmentInfoResponse'

instance Prelude.Hashable RequestEnvironmentInfo where
  hashWithSalt :: Int -> RequestEnvironmentInfo -> Int
hashWithSalt Int
_salt RequestEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
$sel:environmentId:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> 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 RequestEnvironmentInfo where
  rnf :: RequestEnvironmentInfo -> ()
rnf RequestEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
$sel:environmentId:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> 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 RequestEnvironmentInfo where
  toHeaders :: RequestEnvironmentInfo -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery RequestEnvironmentInfo where
  toQuery :: RequestEnvironmentInfo -> QueryString
toQuery RequestEnvironmentInfo' {Maybe Text
EnvironmentInfoType
infoType :: EnvironmentInfoType
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:infoType:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> EnvironmentInfoType
$sel:environmentName:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
$sel:environmentId:RequestEnvironmentInfo' :: RequestEnvironmentInfo -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RequestEnvironmentInfo" :: 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
      ]

-- | /See:/ 'newRequestEnvironmentInfoResponse' smart constructor.
data RequestEnvironmentInfoResponse = RequestEnvironmentInfoResponse'
  {
  }
  deriving (RequestEnvironmentInfoResponse
-> RequestEnvironmentInfoResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestEnvironmentInfoResponse
-> RequestEnvironmentInfoResponse -> Bool
$c/= :: RequestEnvironmentInfoResponse
-> RequestEnvironmentInfoResponse -> Bool
== :: RequestEnvironmentInfoResponse
-> RequestEnvironmentInfoResponse -> Bool
$c== :: RequestEnvironmentInfoResponse
-> RequestEnvironmentInfoResponse -> Bool
Prelude.Eq, ReadPrec [RequestEnvironmentInfoResponse]
ReadPrec RequestEnvironmentInfoResponse
Int -> ReadS RequestEnvironmentInfoResponse
ReadS [RequestEnvironmentInfoResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestEnvironmentInfoResponse]
$creadListPrec :: ReadPrec [RequestEnvironmentInfoResponse]
readPrec :: ReadPrec RequestEnvironmentInfoResponse
$creadPrec :: ReadPrec RequestEnvironmentInfoResponse
readList :: ReadS [RequestEnvironmentInfoResponse]
$creadList :: ReadS [RequestEnvironmentInfoResponse]
readsPrec :: Int -> ReadS RequestEnvironmentInfoResponse
$creadsPrec :: Int -> ReadS RequestEnvironmentInfoResponse
Prelude.Read, Int -> RequestEnvironmentInfoResponse -> ShowS
[RequestEnvironmentInfoResponse] -> ShowS
RequestEnvironmentInfoResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestEnvironmentInfoResponse] -> ShowS
$cshowList :: [RequestEnvironmentInfoResponse] -> ShowS
show :: RequestEnvironmentInfoResponse -> String
$cshow :: RequestEnvironmentInfoResponse -> String
showsPrec :: Int -> RequestEnvironmentInfoResponse -> ShowS
$cshowsPrec :: Int -> RequestEnvironmentInfoResponse -> ShowS
Prelude.Show, forall x.
Rep RequestEnvironmentInfoResponse x
-> RequestEnvironmentInfoResponse
forall x.
RequestEnvironmentInfoResponse
-> Rep RequestEnvironmentInfoResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestEnvironmentInfoResponse x
-> RequestEnvironmentInfoResponse
$cfrom :: forall x.
RequestEnvironmentInfoResponse
-> Rep RequestEnvironmentInfoResponse x
Prelude.Generic)

-- |
-- Create a value of 'RequestEnvironmentInfoResponse' 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.
newRequestEnvironmentInfoResponse ::
  RequestEnvironmentInfoResponse
newRequestEnvironmentInfoResponse :: RequestEnvironmentInfoResponse
newRequestEnvironmentInfoResponse =
  RequestEnvironmentInfoResponse
RequestEnvironmentInfoResponse'

instance
  Prelude.NFData
    RequestEnvironmentInfoResponse
  where
  rnf :: RequestEnvironmentInfoResponse -> ()
rnf RequestEnvironmentInfoResponse
_ = ()