{-# 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.CloudWatch.GetMetricWidgetImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You can use the @GetMetricWidgetImage@ API to retrieve a snapshot graph
-- of one or more Amazon CloudWatch metrics as a bitmap image. You can then
-- embed this image into your services and products, such as wiki pages,
-- reports, and documents. You could also retrieve images regularly, such
-- as every minute, and create your own custom live dashboard.
--
-- The graph you retrieve can include all CloudWatch metric graph features,
-- including metric math and horizontal and vertical annotations.
--
-- There is a limit of 20 transactions per second for this API. Each
-- @GetMetricWidgetImage@ action has the following limits:
--
-- -   As many as 100 metrics in the graph.
--
-- -   Up to 100 KB uncompressed payload.
module Amazonka.CloudWatch.GetMetricWidgetImage
  ( -- * Creating a Request
    GetMetricWidgetImage (..),
    newGetMetricWidgetImage,

    -- * Request Lenses
    getMetricWidgetImage_outputFormat,
    getMetricWidgetImage_metricWidget,

    -- * Destructuring the Response
    GetMetricWidgetImageResponse (..),
    newGetMetricWidgetImageResponse,

    -- * Response Lenses
    getMetricWidgetImageResponse_metricWidgetImage,
    getMetricWidgetImageResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetMetricWidgetImage' smart constructor.
data GetMetricWidgetImage = GetMetricWidgetImage'
  { -- | The format of the resulting image. Only PNG images are supported.
    --
    -- The default is @png@. If you specify @png@, the API returns an HTTP
    -- response with the content-type set to @text\/xml@. The image data is in
    -- a @MetricWidgetImage@ field. For example:
    --
    -- @ \<GetMetricWidgetImageResponse xmlns=\<URLstring>>@
    --
    -- @ \<GetMetricWidgetImageResult>@
    --
    -- @ \<MetricWidgetImage>@
    --
    -- @ iVBORw0KGgoAAAANSUhEUgAAAlgAAAGQEAYAAAAip...@
    --
    -- @ \<\/MetricWidgetImage>@
    --
    -- @ \<\/GetMetricWidgetImageResult>@
    --
    -- @ \<ResponseMetadata>@
    --
    -- @ \<RequestId>6f0d4192-4d42-11e8-82c1-f539a07e0e3b\<\/RequestId>@
    --
    -- @ \<\/ResponseMetadata>@
    --
    -- @\<\/GetMetricWidgetImageResponse>@
    --
    -- The @image\/png@ setting is intended only for custom HTTP requests. For
    -- most use cases, and all actions using an Amazon Web Services SDK, you
    -- should use @png@. If you specify @image\/png@, the HTTP response has a
    -- content-type set to @image\/png@, and the body of the response is a PNG
    -- image.
    GetMetricWidgetImage -> Maybe Text
outputFormat :: Prelude.Maybe Prelude.Text,
    -- | A JSON string that defines the bitmap graph to be retrieved. The string
    -- includes the metrics to include in the graph, statistics, annotations,
    -- title, axis limits, and so on. You can include only one @MetricWidget@
    -- parameter in each @GetMetricWidgetImage@ call.
    --
    -- For more information about the syntax of @MetricWidget@ see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Metric-Widget-Structure.html GetMetricWidgetImage: Metric Widget Structure and Syntax>.
    --
    -- If any metric on the graph could not load all the requested data points,
    -- an orange triangle with an exclamation point appears next to the graph
    -- legend.
    GetMetricWidgetImage -> Text
metricWidget :: Prelude.Text
  }
  deriving (GetMetricWidgetImage -> GetMetricWidgetImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMetricWidgetImage -> GetMetricWidgetImage -> Bool
$c/= :: GetMetricWidgetImage -> GetMetricWidgetImage -> Bool
== :: GetMetricWidgetImage -> GetMetricWidgetImage -> Bool
$c== :: GetMetricWidgetImage -> GetMetricWidgetImage -> Bool
Prelude.Eq, ReadPrec [GetMetricWidgetImage]
ReadPrec GetMetricWidgetImage
Int -> ReadS GetMetricWidgetImage
ReadS [GetMetricWidgetImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMetricWidgetImage]
$creadListPrec :: ReadPrec [GetMetricWidgetImage]
readPrec :: ReadPrec GetMetricWidgetImage
$creadPrec :: ReadPrec GetMetricWidgetImage
readList :: ReadS [GetMetricWidgetImage]
$creadList :: ReadS [GetMetricWidgetImage]
readsPrec :: Int -> ReadS GetMetricWidgetImage
$creadsPrec :: Int -> ReadS GetMetricWidgetImage
Prelude.Read, Int -> GetMetricWidgetImage -> ShowS
[GetMetricWidgetImage] -> ShowS
GetMetricWidgetImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMetricWidgetImage] -> ShowS
$cshowList :: [GetMetricWidgetImage] -> ShowS
show :: GetMetricWidgetImage -> String
$cshow :: GetMetricWidgetImage -> String
showsPrec :: Int -> GetMetricWidgetImage -> ShowS
$cshowsPrec :: Int -> GetMetricWidgetImage -> ShowS
Prelude.Show, forall x. Rep GetMetricWidgetImage x -> GetMetricWidgetImage
forall x. GetMetricWidgetImage -> Rep GetMetricWidgetImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMetricWidgetImage x -> GetMetricWidgetImage
$cfrom :: forall x. GetMetricWidgetImage -> Rep GetMetricWidgetImage x
Prelude.Generic)

-- |
-- Create a value of 'GetMetricWidgetImage' 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:
--
-- 'outputFormat', 'getMetricWidgetImage_outputFormat' - The format of the resulting image. Only PNG images are supported.
--
-- The default is @png@. If you specify @png@, the API returns an HTTP
-- response with the content-type set to @text\/xml@. The image data is in
-- a @MetricWidgetImage@ field. For example:
--
-- @ \<GetMetricWidgetImageResponse xmlns=\<URLstring>>@
--
-- @ \<GetMetricWidgetImageResult>@
--
-- @ \<MetricWidgetImage>@
--
-- @ iVBORw0KGgoAAAANSUhEUgAAAlgAAAGQEAYAAAAip...@
--
-- @ \<\/MetricWidgetImage>@
--
-- @ \<\/GetMetricWidgetImageResult>@
--
-- @ \<ResponseMetadata>@
--
-- @ \<RequestId>6f0d4192-4d42-11e8-82c1-f539a07e0e3b\<\/RequestId>@
--
-- @ \<\/ResponseMetadata>@
--
-- @\<\/GetMetricWidgetImageResponse>@
--
-- The @image\/png@ setting is intended only for custom HTTP requests. For
-- most use cases, and all actions using an Amazon Web Services SDK, you
-- should use @png@. If you specify @image\/png@, the HTTP response has a
-- content-type set to @image\/png@, and the body of the response is a PNG
-- image.
--
-- 'metricWidget', 'getMetricWidgetImage_metricWidget' - A JSON string that defines the bitmap graph to be retrieved. The string
-- includes the metrics to include in the graph, statistics, annotations,
-- title, axis limits, and so on. You can include only one @MetricWidget@
-- parameter in each @GetMetricWidgetImage@ call.
--
-- For more information about the syntax of @MetricWidget@ see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Metric-Widget-Structure.html GetMetricWidgetImage: Metric Widget Structure and Syntax>.
--
-- If any metric on the graph could not load all the requested data points,
-- an orange triangle with an exclamation point appears next to the graph
-- legend.
newGetMetricWidgetImage ::
  -- | 'metricWidget'
  Prelude.Text ->
  GetMetricWidgetImage
newGetMetricWidgetImage :: Text -> GetMetricWidgetImage
newGetMetricWidgetImage Text
pMetricWidget_ =
  GetMetricWidgetImage'
    { $sel:outputFormat:GetMetricWidgetImage' :: Maybe Text
outputFormat =
        forall a. Maybe a
Prelude.Nothing,
      $sel:metricWidget:GetMetricWidgetImage' :: Text
metricWidget = Text
pMetricWidget_
    }

-- | The format of the resulting image. Only PNG images are supported.
--
-- The default is @png@. If you specify @png@, the API returns an HTTP
-- response with the content-type set to @text\/xml@. The image data is in
-- a @MetricWidgetImage@ field. For example:
--
-- @ \<GetMetricWidgetImageResponse xmlns=\<URLstring>>@
--
-- @ \<GetMetricWidgetImageResult>@
--
-- @ \<MetricWidgetImage>@
--
-- @ iVBORw0KGgoAAAANSUhEUgAAAlgAAAGQEAYAAAAip...@
--
-- @ \<\/MetricWidgetImage>@
--
-- @ \<\/GetMetricWidgetImageResult>@
--
-- @ \<ResponseMetadata>@
--
-- @ \<RequestId>6f0d4192-4d42-11e8-82c1-f539a07e0e3b\<\/RequestId>@
--
-- @ \<\/ResponseMetadata>@
--
-- @\<\/GetMetricWidgetImageResponse>@
--
-- The @image\/png@ setting is intended only for custom HTTP requests. For
-- most use cases, and all actions using an Amazon Web Services SDK, you
-- should use @png@. If you specify @image\/png@, the HTTP response has a
-- content-type set to @image\/png@, and the body of the response is a PNG
-- image.
getMetricWidgetImage_outputFormat :: Lens.Lens' GetMetricWidgetImage (Prelude.Maybe Prelude.Text)
getMetricWidgetImage_outputFormat :: Lens' GetMetricWidgetImage (Maybe Text)
getMetricWidgetImage_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetricWidgetImage' {Maybe Text
outputFormat :: Maybe Text
$sel:outputFormat:GetMetricWidgetImage' :: GetMetricWidgetImage -> Maybe Text
outputFormat} -> Maybe Text
outputFormat) (\s :: GetMetricWidgetImage
s@GetMetricWidgetImage' {} Maybe Text
a -> GetMetricWidgetImage
s {$sel:outputFormat:GetMetricWidgetImage' :: Maybe Text
outputFormat = Maybe Text
a} :: GetMetricWidgetImage)

-- | A JSON string that defines the bitmap graph to be retrieved. The string
-- includes the metrics to include in the graph, statistics, annotations,
-- title, axis limits, and so on. You can include only one @MetricWidget@
-- parameter in each @GetMetricWidgetImage@ call.
--
-- For more information about the syntax of @MetricWidget@ see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Metric-Widget-Structure.html GetMetricWidgetImage: Metric Widget Structure and Syntax>.
--
-- If any metric on the graph could not load all the requested data points,
-- an orange triangle with an exclamation point appears next to the graph
-- legend.
getMetricWidgetImage_metricWidget :: Lens.Lens' GetMetricWidgetImage Prelude.Text
getMetricWidgetImage_metricWidget :: Lens' GetMetricWidgetImage Text
getMetricWidgetImage_metricWidget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetricWidgetImage' {Text
metricWidget :: Text
$sel:metricWidget:GetMetricWidgetImage' :: GetMetricWidgetImage -> Text
metricWidget} -> Text
metricWidget) (\s :: GetMetricWidgetImage
s@GetMetricWidgetImage' {} Text
a -> GetMetricWidgetImage
s {$sel:metricWidget:GetMetricWidgetImage' :: Text
metricWidget = Text
a} :: GetMetricWidgetImage)

instance Core.AWSRequest GetMetricWidgetImage where
  type
    AWSResponse GetMetricWidgetImage =
      GetMetricWidgetImageResponse
  request :: (Service -> Service)
-> GetMetricWidgetImage -> Request GetMetricWidgetImage
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 GetMetricWidgetImage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetMetricWidgetImage)))
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
"GetMetricWidgetImageResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Base64 -> Int -> GetMetricWidgetImageResponse
GetMetricWidgetImageResponse'
            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
"MetricWidgetImage")
            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 GetMetricWidgetImage where
  hashWithSalt :: Int -> GetMetricWidgetImage -> Int
hashWithSalt Int
_salt GetMetricWidgetImage' {Maybe Text
Text
metricWidget :: Text
outputFormat :: Maybe Text
$sel:metricWidget:GetMetricWidgetImage' :: GetMetricWidgetImage -> Text
$sel:outputFormat:GetMetricWidgetImage' :: GetMetricWidgetImage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricWidget

instance Prelude.NFData GetMetricWidgetImage where
  rnf :: GetMetricWidgetImage -> ()
rnf GetMetricWidgetImage' {Maybe Text
Text
metricWidget :: Text
outputFormat :: Maybe Text
$sel:metricWidget:GetMetricWidgetImage' :: GetMetricWidgetImage -> Text
$sel:outputFormat:GetMetricWidgetImage' :: GetMetricWidgetImage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
metricWidget

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

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

instance Data.ToQuery GetMetricWidgetImage where
  toQuery :: GetMetricWidgetImage -> QueryString
toQuery GetMetricWidgetImage' {Maybe Text
Text
metricWidget :: Text
outputFormat :: Maybe Text
$sel:metricWidget:GetMetricWidgetImage' :: GetMetricWidgetImage -> Text
$sel:outputFormat:GetMetricWidgetImage' :: GetMetricWidgetImage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetMetricWidgetImage" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"OutputFormat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outputFormat,
        ByteString
"MetricWidget" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
metricWidget
      ]

-- | /See:/ 'newGetMetricWidgetImageResponse' smart constructor.
data GetMetricWidgetImageResponse = GetMetricWidgetImageResponse'
  { -- | The image of the graph, in the output format specified. The output is
    -- base64-encoded.
    GetMetricWidgetImageResponse -> Maybe Base64
metricWidgetImage :: Prelude.Maybe Data.Base64,
    -- | The response's http status code.
    GetMetricWidgetImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMetricWidgetImageResponse
-> GetMetricWidgetImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMetricWidgetImageResponse
-> GetMetricWidgetImageResponse -> Bool
$c/= :: GetMetricWidgetImageResponse
-> GetMetricWidgetImageResponse -> Bool
== :: GetMetricWidgetImageResponse
-> GetMetricWidgetImageResponse -> Bool
$c== :: GetMetricWidgetImageResponse
-> GetMetricWidgetImageResponse -> Bool
Prelude.Eq, ReadPrec [GetMetricWidgetImageResponse]
ReadPrec GetMetricWidgetImageResponse
Int -> ReadS GetMetricWidgetImageResponse
ReadS [GetMetricWidgetImageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMetricWidgetImageResponse]
$creadListPrec :: ReadPrec [GetMetricWidgetImageResponse]
readPrec :: ReadPrec GetMetricWidgetImageResponse
$creadPrec :: ReadPrec GetMetricWidgetImageResponse
readList :: ReadS [GetMetricWidgetImageResponse]
$creadList :: ReadS [GetMetricWidgetImageResponse]
readsPrec :: Int -> ReadS GetMetricWidgetImageResponse
$creadsPrec :: Int -> ReadS GetMetricWidgetImageResponse
Prelude.Read, Int -> GetMetricWidgetImageResponse -> ShowS
[GetMetricWidgetImageResponse] -> ShowS
GetMetricWidgetImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMetricWidgetImageResponse] -> ShowS
$cshowList :: [GetMetricWidgetImageResponse] -> ShowS
show :: GetMetricWidgetImageResponse -> String
$cshow :: GetMetricWidgetImageResponse -> String
showsPrec :: Int -> GetMetricWidgetImageResponse -> ShowS
$cshowsPrec :: Int -> GetMetricWidgetImageResponse -> ShowS
Prelude.Show, forall x.
Rep GetMetricWidgetImageResponse x -> GetMetricWidgetImageResponse
forall x.
GetMetricWidgetImageResponse -> Rep GetMetricWidgetImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetMetricWidgetImageResponse x -> GetMetricWidgetImageResponse
$cfrom :: forall x.
GetMetricWidgetImageResponse -> Rep GetMetricWidgetImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMetricWidgetImageResponse' 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:
--
-- 'metricWidgetImage', 'getMetricWidgetImageResponse_metricWidgetImage' - The image of the graph, in the output format specified. The output is
-- base64-encoded.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'httpStatus', 'getMetricWidgetImageResponse_httpStatus' - The response's http status code.
newGetMetricWidgetImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMetricWidgetImageResponse
newGetMetricWidgetImageResponse :: Int -> GetMetricWidgetImageResponse
newGetMetricWidgetImageResponse Int
pHttpStatus_ =
  GetMetricWidgetImageResponse'
    { $sel:metricWidgetImage:GetMetricWidgetImageResponse' :: Maybe Base64
metricWidgetImage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMetricWidgetImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The image of the graph, in the output format specified. The output is
-- base64-encoded.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
getMetricWidgetImageResponse_metricWidgetImage :: Lens.Lens' GetMetricWidgetImageResponse (Prelude.Maybe Prelude.ByteString)
getMetricWidgetImageResponse_metricWidgetImage :: Lens' GetMetricWidgetImageResponse (Maybe ByteString)
getMetricWidgetImageResponse_metricWidgetImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetricWidgetImageResponse' {Maybe Base64
metricWidgetImage :: Maybe Base64
$sel:metricWidgetImage:GetMetricWidgetImageResponse' :: GetMetricWidgetImageResponse -> Maybe Base64
metricWidgetImage} -> Maybe Base64
metricWidgetImage) (\s :: GetMetricWidgetImageResponse
s@GetMetricWidgetImageResponse' {} Maybe Base64
a -> GetMetricWidgetImageResponse
s {$sel:metricWidgetImage:GetMetricWidgetImageResponse' :: Maybe Base64
metricWidgetImage = Maybe Base64
a} :: GetMetricWidgetImageResponse) 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 Iso' Base64 ByteString
Data._Base64

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

instance Prelude.NFData GetMetricWidgetImageResponse where
  rnf :: GetMetricWidgetImageResponse -> ()
rnf GetMetricWidgetImageResponse' {Int
Maybe Base64
httpStatus :: Int
metricWidgetImage :: Maybe Base64
$sel:httpStatus:GetMetricWidgetImageResponse' :: GetMetricWidgetImageResponse -> Int
$sel:metricWidgetImage:GetMetricWidgetImageResponse' :: GetMetricWidgetImageResponse -> Maybe Base64
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
metricWidgetImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus