{-# 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.ResourceGroupsTagging.DescribeReportCreation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the status of the @StartReportCreation@ operation.
--
-- You can call this operation only from the organization\'s management
-- account and from the us-east-1 Region.
module Amazonka.ResourceGroupsTagging.DescribeReportCreation
  ( -- * Creating a Request
    DescribeReportCreation (..),
    newDescribeReportCreation,

    -- * Destructuring the Response
    DescribeReportCreationResponse (..),
    newDescribeReportCreationResponse,

    -- * Response Lenses
    describeReportCreationResponse_errorMessage,
    describeReportCreationResponse_s3Location,
    describeReportCreationResponse_status,
    describeReportCreationResponse_httpStatus,
  )
where

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 Amazonka.ResourceGroupsTagging.Types
import qualified Amazonka.Response as Response

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

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

instance Core.AWSRequest DescribeReportCreation where
  type
    AWSResponse DescribeReportCreation =
      DescribeReportCreationResponse
  request :: (Service -> Service)
-> DescribeReportCreation -> Request DescribeReportCreation
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 DescribeReportCreation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeReportCreation)))
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 Text
-> Int
-> DescribeReportCreationResponse
DescribeReportCreationResponse'
            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
"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
"S3Location")
            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
"Status")
            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 DescribeReportCreation where
  hashWithSalt :: Int -> DescribeReportCreation -> Int
hashWithSalt Int
_salt DescribeReportCreation
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance Data.ToHeaders DescribeReportCreation where
  toHeaders :: DescribeReportCreation -> 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
"ResourceGroupsTaggingAPI_20170126.DescribeReportCreation" ::
                          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 DescribeReportCreation where
  toJSON :: DescribeReportCreation -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newDescribeReportCreationResponse' smart constructor.
data DescribeReportCreationResponse = DescribeReportCreationResponse'
  { -- | Details of the common errors that all operations return.
    DescribeReportCreationResponse -> Maybe Text
errorMessage :: Prelude.Maybe Prelude.Text,
    -- | The path to the Amazon S3 bucket where the report was stored on
    -- creation.
    DescribeReportCreationResponse -> Maybe Text
s3Location :: Prelude.Maybe Prelude.Text,
    -- | Reports the status of the operation.
    --
    -- The operation status can be one of the following:
    --
    -- -   @RUNNING@ - Report creation is in progress.
    --
    -- -   @SUCCEEDED@ - Report creation is complete. You can open the report
    --     from the Amazon S3 bucket that you specified when you ran
    --     @StartReportCreation@.
    --
    -- -   @FAILED@ - Report creation timed out or the Amazon S3 bucket is not
    --     accessible.
    --
    -- -   @NO REPORT@ - No report was generated in the last 90 days.
    DescribeReportCreationResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeReportCreationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeReportCreationResponse
-> DescribeReportCreationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeReportCreationResponse
-> DescribeReportCreationResponse -> Bool
$c/= :: DescribeReportCreationResponse
-> DescribeReportCreationResponse -> Bool
== :: DescribeReportCreationResponse
-> DescribeReportCreationResponse -> Bool
$c== :: DescribeReportCreationResponse
-> DescribeReportCreationResponse -> Bool
Prelude.Eq, ReadPrec [DescribeReportCreationResponse]
ReadPrec DescribeReportCreationResponse
Int -> ReadS DescribeReportCreationResponse
ReadS [DescribeReportCreationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeReportCreationResponse]
$creadListPrec :: ReadPrec [DescribeReportCreationResponse]
readPrec :: ReadPrec DescribeReportCreationResponse
$creadPrec :: ReadPrec DescribeReportCreationResponse
readList :: ReadS [DescribeReportCreationResponse]
$creadList :: ReadS [DescribeReportCreationResponse]
readsPrec :: Int -> ReadS DescribeReportCreationResponse
$creadsPrec :: Int -> ReadS DescribeReportCreationResponse
Prelude.Read, Int -> DescribeReportCreationResponse -> ShowS
[DescribeReportCreationResponse] -> ShowS
DescribeReportCreationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeReportCreationResponse] -> ShowS
$cshowList :: [DescribeReportCreationResponse] -> ShowS
show :: DescribeReportCreationResponse -> String
$cshow :: DescribeReportCreationResponse -> String
showsPrec :: Int -> DescribeReportCreationResponse -> ShowS
$cshowsPrec :: Int -> DescribeReportCreationResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeReportCreationResponse x
-> DescribeReportCreationResponse
forall x.
DescribeReportCreationResponse
-> Rep DescribeReportCreationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeReportCreationResponse x
-> DescribeReportCreationResponse
$cfrom :: forall x.
DescribeReportCreationResponse
-> Rep DescribeReportCreationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeReportCreationResponse' 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:
--
-- 'errorMessage', 'describeReportCreationResponse_errorMessage' - Details of the common errors that all operations return.
--
-- 's3Location', 'describeReportCreationResponse_s3Location' - The path to the Amazon S3 bucket where the report was stored on
-- creation.
--
-- 'status', 'describeReportCreationResponse_status' - Reports the status of the operation.
--
-- The operation status can be one of the following:
--
-- -   @RUNNING@ - Report creation is in progress.
--
-- -   @SUCCEEDED@ - Report creation is complete. You can open the report
--     from the Amazon S3 bucket that you specified when you ran
--     @StartReportCreation@.
--
-- -   @FAILED@ - Report creation timed out or the Amazon S3 bucket is not
--     accessible.
--
-- -   @NO REPORT@ - No report was generated in the last 90 days.
--
-- 'httpStatus', 'describeReportCreationResponse_httpStatus' - The response's http status code.
newDescribeReportCreationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeReportCreationResponse
newDescribeReportCreationResponse :: Int -> DescribeReportCreationResponse
newDescribeReportCreationResponse Int
pHttpStatus_ =
  DescribeReportCreationResponse'
    { $sel:errorMessage:DescribeReportCreationResponse' :: Maybe Text
errorMessage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:s3Location:DescribeReportCreationResponse' :: Maybe Text
s3Location = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeReportCreationResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeReportCreationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details of the common errors that all operations return.
describeReportCreationResponse_errorMessage :: Lens.Lens' DescribeReportCreationResponse (Prelude.Maybe Prelude.Text)
describeReportCreationResponse_errorMessage :: Lens' DescribeReportCreationResponse (Maybe Text)
describeReportCreationResponse_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReportCreationResponse' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: DescribeReportCreationResponse
s@DescribeReportCreationResponse' {} Maybe Text
a -> DescribeReportCreationResponse
s {$sel:errorMessage:DescribeReportCreationResponse' :: Maybe Text
errorMessage = Maybe Text
a} :: DescribeReportCreationResponse)

-- | The path to the Amazon S3 bucket where the report was stored on
-- creation.
describeReportCreationResponse_s3Location :: Lens.Lens' DescribeReportCreationResponse (Prelude.Maybe Prelude.Text)
describeReportCreationResponse_s3Location :: Lens' DescribeReportCreationResponse (Maybe Text)
describeReportCreationResponse_s3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReportCreationResponse' {Maybe Text
s3Location :: Maybe Text
$sel:s3Location:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
s3Location} -> Maybe Text
s3Location) (\s :: DescribeReportCreationResponse
s@DescribeReportCreationResponse' {} Maybe Text
a -> DescribeReportCreationResponse
s {$sel:s3Location:DescribeReportCreationResponse' :: Maybe Text
s3Location = Maybe Text
a} :: DescribeReportCreationResponse)

-- | Reports the status of the operation.
--
-- The operation status can be one of the following:
--
-- -   @RUNNING@ - Report creation is in progress.
--
-- -   @SUCCEEDED@ - Report creation is complete. You can open the report
--     from the Amazon S3 bucket that you specified when you ran
--     @StartReportCreation@.
--
-- -   @FAILED@ - Report creation timed out or the Amazon S3 bucket is not
--     accessible.
--
-- -   @NO REPORT@ - No report was generated in the last 90 days.
describeReportCreationResponse_status :: Lens.Lens' DescribeReportCreationResponse (Prelude.Maybe Prelude.Text)
describeReportCreationResponse_status :: Lens' DescribeReportCreationResponse (Maybe Text)
describeReportCreationResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReportCreationResponse' {Maybe Text
status :: Maybe Text
$sel:status:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: DescribeReportCreationResponse
s@DescribeReportCreationResponse' {} Maybe Text
a -> DescribeReportCreationResponse
s {$sel:status:DescribeReportCreationResponse' :: Maybe Text
status = Maybe Text
a} :: DescribeReportCreationResponse)

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

instance
  Prelude.NFData
    DescribeReportCreationResponse
  where
  rnf :: DescribeReportCreationResponse -> ()
rnf DescribeReportCreationResponse' {Int
Maybe Text
httpStatus :: Int
status :: Maybe Text
s3Location :: Maybe Text
errorMessage :: Maybe Text
$sel:httpStatus:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Int
$sel:status:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
$sel:s3Location:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
$sel:errorMessage:DescribeReportCreationResponse' :: DescribeReportCreationResponse -> Maybe Text
..} =
    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 Text
s3Location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus