{-# 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.QuickSight.DescribeAnalysis
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides a summary of the metadata for an analysis.
module Amazonka.QuickSight.DescribeAnalysis
  ( -- * Creating a Request
    DescribeAnalysis (..),
    newDescribeAnalysis,

    -- * Request Lenses
    describeAnalysis_awsAccountId,
    describeAnalysis_analysisId,

    -- * Destructuring the Response
    DescribeAnalysisResponse (..),
    newDescribeAnalysisResponse,

    -- * Response Lenses
    describeAnalysisResponse_analysis,
    describeAnalysisResponse_requestId,
    describeAnalysisResponse_status,
  )
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 Amazonka.QuickSight.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeAnalysis' smart constructor.
data DescribeAnalysis = DescribeAnalysis'
  { -- | The ID of the Amazon Web Services account that contains the analysis.
    -- You must be using the Amazon Web Services account that the analysis is
    -- in.
    DescribeAnalysis -> Text
awsAccountId :: Prelude.Text,
    -- | The ID of the analysis that you\'re describing. The ID is part of the
    -- URL of the analysis.
    DescribeAnalysis -> Text
analysisId :: Prelude.Text
  }
  deriving (DescribeAnalysis -> DescribeAnalysis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAnalysis -> DescribeAnalysis -> Bool
$c/= :: DescribeAnalysis -> DescribeAnalysis -> Bool
== :: DescribeAnalysis -> DescribeAnalysis -> Bool
$c== :: DescribeAnalysis -> DescribeAnalysis -> Bool
Prelude.Eq, ReadPrec [DescribeAnalysis]
ReadPrec DescribeAnalysis
Int -> ReadS DescribeAnalysis
ReadS [DescribeAnalysis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAnalysis]
$creadListPrec :: ReadPrec [DescribeAnalysis]
readPrec :: ReadPrec DescribeAnalysis
$creadPrec :: ReadPrec DescribeAnalysis
readList :: ReadS [DescribeAnalysis]
$creadList :: ReadS [DescribeAnalysis]
readsPrec :: Int -> ReadS DescribeAnalysis
$creadsPrec :: Int -> ReadS DescribeAnalysis
Prelude.Read, Int -> DescribeAnalysis -> ShowS
[DescribeAnalysis] -> ShowS
DescribeAnalysis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAnalysis] -> ShowS
$cshowList :: [DescribeAnalysis] -> ShowS
show :: DescribeAnalysis -> String
$cshow :: DescribeAnalysis -> String
showsPrec :: Int -> DescribeAnalysis -> ShowS
$cshowsPrec :: Int -> DescribeAnalysis -> ShowS
Prelude.Show, forall x. Rep DescribeAnalysis x -> DescribeAnalysis
forall x. DescribeAnalysis -> Rep DescribeAnalysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAnalysis x -> DescribeAnalysis
$cfrom :: forall x. DescribeAnalysis -> Rep DescribeAnalysis x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAnalysis' 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:
--
-- 'awsAccountId', 'describeAnalysis_awsAccountId' - The ID of the Amazon Web Services account that contains the analysis.
-- You must be using the Amazon Web Services account that the analysis is
-- in.
--
-- 'analysisId', 'describeAnalysis_analysisId' - The ID of the analysis that you\'re describing. The ID is part of the
-- URL of the analysis.
newDescribeAnalysis ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'analysisId'
  Prelude.Text ->
  DescribeAnalysis
newDescribeAnalysis :: Text -> Text -> DescribeAnalysis
newDescribeAnalysis Text
pAwsAccountId_ Text
pAnalysisId_ =
  DescribeAnalysis'
    { $sel:awsAccountId:DescribeAnalysis' :: Text
awsAccountId = Text
pAwsAccountId_,
      $sel:analysisId:DescribeAnalysis' :: Text
analysisId = Text
pAnalysisId_
    }

-- | The ID of the Amazon Web Services account that contains the analysis.
-- You must be using the Amazon Web Services account that the analysis is
-- in.
describeAnalysis_awsAccountId :: Lens.Lens' DescribeAnalysis Prelude.Text
describeAnalysis_awsAccountId :: Lens' DescribeAnalysis Text
describeAnalysis_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAnalysis' {Text
awsAccountId :: Text
$sel:awsAccountId:DescribeAnalysis' :: DescribeAnalysis -> Text
awsAccountId} -> Text
awsAccountId) (\s :: DescribeAnalysis
s@DescribeAnalysis' {} Text
a -> DescribeAnalysis
s {$sel:awsAccountId:DescribeAnalysis' :: Text
awsAccountId = Text
a} :: DescribeAnalysis)

-- | The ID of the analysis that you\'re describing. The ID is part of the
-- URL of the analysis.
describeAnalysis_analysisId :: Lens.Lens' DescribeAnalysis Prelude.Text
describeAnalysis_analysisId :: Lens' DescribeAnalysis Text
describeAnalysis_analysisId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAnalysis' {Text
analysisId :: Text
$sel:analysisId:DescribeAnalysis' :: DescribeAnalysis -> Text
analysisId} -> Text
analysisId) (\s :: DescribeAnalysis
s@DescribeAnalysis' {} Text
a -> DescribeAnalysis
s {$sel:analysisId:DescribeAnalysis' :: Text
analysisId = Text
a} :: DescribeAnalysis)

instance Core.AWSRequest DescribeAnalysis where
  type
    AWSResponse DescribeAnalysis =
      DescribeAnalysisResponse
  request :: (Service -> Service)
-> DescribeAnalysis -> Request DescribeAnalysis
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeAnalysis
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeAnalysis)))
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 Analysis -> Maybe Text -> Int -> DescribeAnalysisResponse
DescribeAnalysisResponse'
            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
"Analysis")
            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
"RequestId")
            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 DescribeAnalysis where
  hashWithSalt :: Int -> DescribeAnalysis -> Int
hashWithSalt Int
_salt DescribeAnalysis' {Text
analysisId :: Text
awsAccountId :: Text
$sel:analysisId:DescribeAnalysis' :: DescribeAnalysis -> Text
$sel:awsAccountId:DescribeAnalysis' :: DescribeAnalysis -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analysisId

instance Prelude.NFData DescribeAnalysis where
  rnf :: DescribeAnalysis -> ()
rnf DescribeAnalysis' {Text
analysisId :: Text
awsAccountId :: Text
$sel:analysisId:DescribeAnalysis' :: DescribeAnalysis -> Text
$sel:awsAccountId:DescribeAnalysis' :: DescribeAnalysis -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
analysisId

instance Data.ToHeaders DescribeAnalysis where
  toHeaders :: DescribeAnalysis -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DescribeAnalysis where
  toPath :: DescribeAnalysis -> ByteString
toPath DescribeAnalysis' {Text
analysisId :: Text
awsAccountId :: Text
$sel:analysisId:DescribeAnalysis' :: DescribeAnalysis -> Text
$sel:awsAccountId:DescribeAnalysis' :: DescribeAnalysis -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/analyses/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
analysisId
      ]

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

-- | /See:/ 'newDescribeAnalysisResponse' smart constructor.
data DescribeAnalysisResponse = DescribeAnalysisResponse'
  { -- | A metadata structure that contains summary information for the analysis
    -- that you\'re describing.
    DescribeAnalysisResponse -> Maybe Analysis
analysis :: Prelude.Maybe Analysis,
    -- | The Amazon Web Services request ID for this operation.
    DescribeAnalysisResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The HTTP status of the request.
    DescribeAnalysisResponse -> Int
status :: Prelude.Int
  }
  deriving (DescribeAnalysisResponse -> DescribeAnalysisResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAnalysisResponse -> DescribeAnalysisResponse -> Bool
$c/= :: DescribeAnalysisResponse -> DescribeAnalysisResponse -> Bool
== :: DescribeAnalysisResponse -> DescribeAnalysisResponse -> Bool
$c== :: DescribeAnalysisResponse -> DescribeAnalysisResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAnalysisResponse]
ReadPrec DescribeAnalysisResponse
Int -> ReadS DescribeAnalysisResponse
ReadS [DescribeAnalysisResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAnalysisResponse]
$creadListPrec :: ReadPrec [DescribeAnalysisResponse]
readPrec :: ReadPrec DescribeAnalysisResponse
$creadPrec :: ReadPrec DescribeAnalysisResponse
readList :: ReadS [DescribeAnalysisResponse]
$creadList :: ReadS [DescribeAnalysisResponse]
readsPrec :: Int -> ReadS DescribeAnalysisResponse
$creadsPrec :: Int -> ReadS DescribeAnalysisResponse
Prelude.Read, Int -> DescribeAnalysisResponse -> ShowS
[DescribeAnalysisResponse] -> ShowS
DescribeAnalysisResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAnalysisResponse] -> ShowS
$cshowList :: [DescribeAnalysisResponse] -> ShowS
show :: DescribeAnalysisResponse -> String
$cshow :: DescribeAnalysisResponse -> String
showsPrec :: Int -> DescribeAnalysisResponse -> ShowS
$cshowsPrec :: Int -> DescribeAnalysisResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeAnalysisResponse x -> DescribeAnalysisResponse
forall x.
DescribeAnalysisResponse -> Rep DescribeAnalysisResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAnalysisResponse x -> DescribeAnalysisResponse
$cfrom :: forall x.
DescribeAnalysisResponse -> Rep DescribeAnalysisResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAnalysisResponse' 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:
--
-- 'analysis', 'describeAnalysisResponse_analysis' - A metadata structure that contains summary information for the analysis
-- that you\'re describing.
--
-- 'requestId', 'describeAnalysisResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'status', 'describeAnalysisResponse_status' - The HTTP status of the request.
newDescribeAnalysisResponse ::
  -- | 'status'
  Prelude.Int ->
  DescribeAnalysisResponse
newDescribeAnalysisResponse :: Int -> DescribeAnalysisResponse
newDescribeAnalysisResponse Int
pStatus_ =
  DescribeAnalysisResponse'
    { $sel:analysis:DescribeAnalysisResponse' :: Maybe Analysis
analysis =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:DescribeAnalysisResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeAnalysisResponse' :: Int
status = Int
pStatus_
    }

-- | A metadata structure that contains summary information for the analysis
-- that you\'re describing.
describeAnalysisResponse_analysis :: Lens.Lens' DescribeAnalysisResponse (Prelude.Maybe Analysis)
describeAnalysisResponse_analysis :: Lens' DescribeAnalysisResponse (Maybe Analysis)
describeAnalysisResponse_analysis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAnalysisResponse' {Maybe Analysis
analysis :: Maybe Analysis
$sel:analysis:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Maybe Analysis
analysis} -> Maybe Analysis
analysis) (\s :: DescribeAnalysisResponse
s@DescribeAnalysisResponse' {} Maybe Analysis
a -> DescribeAnalysisResponse
s {$sel:analysis:DescribeAnalysisResponse' :: Maybe Analysis
analysis = Maybe Analysis
a} :: DescribeAnalysisResponse)

-- | The Amazon Web Services request ID for this operation.
describeAnalysisResponse_requestId :: Lens.Lens' DescribeAnalysisResponse (Prelude.Maybe Prelude.Text)
describeAnalysisResponse_requestId :: Lens' DescribeAnalysisResponse (Maybe Text)
describeAnalysisResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAnalysisResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: DescribeAnalysisResponse
s@DescribeAnalysisResponse' {} Maybe Text
a -> DescribeAnalysisResponse
s {$sel:requestId:DescribeAnalysisResponse' :: Maybe Text
requestId = Maybe Text
a} :: DescribeAnalysisResponse)

-- | The HTTP status of the request.
describeAnalysisResponse_status :: Lens.Lens' DescribeAnalysisResponse Prelude.Int
describeAnalysisResponse_status :: Lens' DescribeAnalysisResponse Int
describeAnalysisResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAnalysisResponse' {Int
status :: Int
$sel:status:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Int
status} -> Int
status) (\s :: DescribeAnalysisResponse
s@DescribeAnalysisResponse' {} Int
a -> DescribeAnalysisResponse
s {$sel:status:DescribeAnalysisResponse' :: Int
status = Int
a} :: DescribeAnalysisResponse)

instance Prelude.NFData DescribeAnalysisResponse where
  rnf :: DescribeAnalysisResponse -> ()
rnf DescribeAnalysisResponse' {Int
Maybe Text
Maybe Analysis
status :: Int
requestId :: Maybe Text
analysis :: Maybe Analysis
$sel:status:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Int
$sel:requestId:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Maybe Text
$sel:analysis:DescribeAnalysisResponse' :: DescribeAnalysisResponse -> Maybe Analysis
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Analysis
analysis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
status