{-# 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.WellArchitected.ExportLens
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Export an existing lens.
--
-- Lenses are defined in JSON. For more information, see
-- <https://docs.aws.amazon.com/wellarchitected/latest/userguide/lenses-format-specification.html JSON format specification>
-- in the /Well-Architected Tool User Guide/. Only the owner of a lens can
-- export it.
--
-- __Disclaimer__
--
-- Do not include or gather personal identifiable information (PII) of end
-- users or other identifiable individuals in or via your custom lenses. If
-- your custom lens or those shared with you and used in your account do
-- include or collect PII you are responsible for: ensuring that the
-- included PII is processed in accordance with applicable law, providing
-- adequate privacy notices, and obtaining necessary consents for
-- processing such data.
module Amazonka.WellArchitected.ExportLens
  ( -- * Creating a Request
    ExportLens (..),
    newExportLens,

    -- * Request Lenses
    exportLens_lensVersion,
    exportLens_lensAlias,

    -- * Destructuring the Response
    ExportLensResponse (..),
    newExportLensResponse,

    -- * Response Lenses
    exportLensResponse_lensJSON,
    exportLensResponse_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 qualified Amazonka.Response as Response
import Amazonka.WellArchitected.Types

-- | /See:/ 'newExportLens' smart constructor.
data ExportLens = ExportLens'
  { -- | The lens version to be exported.
    ExportLens -> Maybe Text
lensVersion :: Prelude.Maybe Prelude.Text,
    ExportLens -> Text
lensAlias :: Prelude.Text
  }
  deriving (ExportLens -> ExportLens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportLens -> ExportLens -> Bool
$c/= :: ExportLens -> ExportLens -> Bool
== :: ExportLens -> ExportLens -> Bool
$c== :: ExportLens -> ExportLens -> Bool
Prelude.Eq, ReadPrec [ExportLens]
ReadPrec ExportLens
Int -> ReadS ExportLens
ReadS [ExportLens]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportLens]
$creadListPrec :: ReadPrec [ExportLens]
readPrec :: ReadPrec ExportLens
$creadPrec :: ReadPrec ExportLens
readList :: ReadS [ExportLens]
$creadList :: ReadS [ExportLens]
readsPrec :: Int -> ReadS ExportLens
$creadsPrec :: Int -> ReadS ExportLens
Prelude.Read, Int -> ExportLens -> ShowS
[ExportLens] -> ShowS
ExportLens -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportLens] -> ShowS
$cshowList :: [ExportLens] -> ShowS
show :: ExportLens -> String
$cshow :: ExportLens -> String
showsPrec :: Int -> ExportLens -> ShowS
$cshowsPrec :: Int -> ExportLens -> ShowS
Prelude.Show, forall x. Rep ExportLens x -> ExportLens
forall x. ExportLens -> Rep ExportLens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportLens x -> ExportLens
$cfrom :: forall x. ExportLens -> Rep ExportLens x
Prelude.Generic)

-- |
-- Create a value of 'ExportLens' 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:
--
-- 'lensVersion', 'exportLens_lensVersion' - The lens version to be exported.
--
-- 'lensAlias', 'exportLens_lensAlias' - Undocumented member.
newExportLens ::
  -- | 'lensAlias'
  Prelude.Text ->
  ExportLens
newExportLens :: Text -> ExportLens
newExportLens Text
pLensAlias_ =
  ExportLens'
    { $sel:lensVersion:ExportLens' :: Maybe Text
lensVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:lensAlias:ExportLens' :: Text
lensAlias = Text
pLensAlias_
    }

-- | The lens version to be exported.
exportLens_lensVersion :: Lens.Lens' ExportLens (Prelude.Maybe Prelude.Text)
exportLens_lensVersion :: Lens' ExportLens (Maybe Text)
exportLens_lensVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportLens' {Maybe Text
lensVersion :: Maybe Text
$sel:lensVersion:ExportLens' :: ExportLens -> Maybe Text
lensVersion} -> Maybe Text
lensVersion) (\s :: ExportLens
s@ExportLens' {} Maybe Text
a -> ExportLens
s {$sel:lensVersion:ExportLens' :: Maybe Text
lensVersion = Maybe Text
a} :: ExportLens)

-- | Undocumented member.
exportLens_lensAlias :: Lens.Lens' ExportLens Prelude.Text
exportLens_lensAlias :: Lens' ExportLens Text
exportLens_lensAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportLens' {Text
lensAlias :: Text
$sel:lensAlias:ExportLens' :: ExportLens -> Text
lensAlias} -> Text
lensAlias) (\s :: ExportLens
s@ExportLens' {} Text
a -> ExportLens
s {$sel:lensAlias:ExportLens' :: Text
lensAlias = Text
a} :: ExportLens)

instance Core.AWSRequest ExportLens where
  type AWSResponse ExportLens = ExportLensResponse
  request :: (Service -> Service) -> ExportLens -> Request ExportLens
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 ExportLens
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExportLens)))
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 -> Int -> ExportLensResponse
ExportLensResponse'
            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
"LensJSON")
            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 ExportLens where
  hashWithSalt :: Int -> ExportLens -> Int
hashWithSalt Int
_salt ExportLens' {Maybe Text
Text
lensAlias :: Text
lensVersion :: Maybe Text
$sel:lensAlias:ExportLens' :: ExportLens -> Text
$sel:lensVersion:ExportLens' :: ExportLens -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lensVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lensAlias

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

instance Data.ToHeaders ExportLens where
  toHeaders :: ExportLens -> 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.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ExportLens where
  toPath :: ExportLens -> ByteString
toPath ExportLens' {Maybe Text
Text
lensAlias :: Text
lensVersion :: Maybe Text
$sel:lensAlias:ExportLens' :: ExportLens -> Text
$sel:lensVersion:ExportLens' :: ExportLens -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/lenses/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
lensAlias, ByteString
"/export"]

instance Data.ToQuery ExportLens where
  toQuery :: ExportLens -> QueryString
toQuery ExportLens' {Maybe Text
Text
lensAlias :: Text
lensVersion :: Maybe Text
$sel:lensAlias:ExportLens' :: ExportLens -> Text
$sel:lensVersion:ExportLens' :: ExportLens -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"LensVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
lensVersion]

-- | /See:/ 'newExportLensResponse' smart constructor.
data ExportLensResponse = ExportLensResponse'
  { -- | The JSON for the lens.
    ExportLensResponse -> Maybe Text
lensJSON :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExportLensResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportLensResponse -> ExportLensResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportLensResponse -> ExportLensResponse -> Bool
$c/= :: ExportLensResponse -> ExportLensResponse -> Bool
== :: ExportLensResponse -> ExportLensResponse -> Bool
$c== :: ExportLensResponse -> ExportLensResponse -> Bool
Prelude.Eq, ReadPrec [ExportLensResponse]
ReadPrec ExportLensResponse
Int -> ReadS ExportLensResponse
ReadS [ExportLensResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportLensResponse]
$creadListPrec :: ReadPrec [ExportLensResponse]
readPrec :: ReadPrec ExportLensResponse
$creadPrec :: ReadPrec ExportLensResponse
readList :: ReadS [ExportLensResponse]
$creadList :: ReadS [ExportLensResponse]
readsPrec :: Int -> ReadS ExportLensResponse
$creadsPrec :: Int -> ReadS ExportLensResponse
Prelude.Read, Int -> ExportLensResponse -> ShowS
[ExportLensResponse] -> ShowS
ExportLensResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportLensResponse] -> ShowS
$cshowList :: [ExportLensResponse] -> ShowS
show :: ExportLensResponse -> String
$cshow :: ExportLensResponse -> String
showsPrec :: Int -> ExportLensResponse -> ShowS
$cshowsPrec :: Int -> ExportLensResponse -> ShowS
Prelude.Show, forall x. Rep ExportLensResponse x -> ExportLensResponse
forall x. ExportLensResponse -> Rep ExportLensResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportLensResponse x -> ExportLensResponse
$cfrom :: forall x. ExportLensResponse -> Rep ExportLensResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportLensResponse' 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:
--
-- 'lensJSON', 'exportLensResponse_lensJSON' - The JSON for the lens.
--
-- 'httpStatus', 'exportLensResponse_httpStatus' - The response's http status code.
newExportLensResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportLensResponse
newExportLensResponse :: Int -> ExportLensResponse
newExportLensResponse Int
pHttpStatus_ =
  ExportLensResponse'
    { $sel:lensJSON:ExportLensResponse' :: Maybe Text
lensJSON = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExportLensResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The JSON for the lens.
exportLensResponse_lensJSON :: Lens.Lens' ExportLensResponse (Prelude.Maybe Prelude.Text)
exportLensResponse_lensJSON :: Lens' ExportLensResponse (Maybe Text)
exportLensResponse_lensJSON = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportLensResponse' {Maybe Text
lensJSON :: Maybe Text
$sel:lensJSON:ExportLensResponse' :: ExportLensResponse -> Maybe Text
lensJSON} -> Maybe Text
lensJSON) (\s :: ExportLensResponse
s@ExportLensResponse' {} Maybe Text
a -> ExportLensResponse
s {$sel:lensJSON:ExportLensResponse' :: Maybe Text
lensJSON = Maybe Text
a} :: ExportLensResponse)

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

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