{-# 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.ImportLens
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Import a new lens.
--
-- The lens cannot be applied to workloads or shared with other Amazon Web
-- Services accounts until it\'s published with CreateLensVersion
--
-- 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/.
--
-- A custom lens cannot exceed 500 KB in size.
--
-- __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.ImportLens
  ( -- * Creating a Request
    ImportLens (..),
    newImportLens,

    -- * Request Lenses
    importLens_lensAlias,
    importLens_tags,
    importLens_jSONString,
    importLens_clientRequestToken,

    -- * Destructuring the Response
    ImportLensResponse (..),
    newImportLensResponse,

    -- * Response Lenses
    importLensResponse_lensArn,
    importLensResponse_status,
    importLensResponse_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:/ 'newImportLens' smart constructor.
data ImportLens = ImportLens'
  { ImportLens -> Maybe Text
lensAlias :: Prelude.Maybe Prelude.Text,
    -- | Tags to associate to a lens.
    ImportLens -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The JSON representation of a lens.
    ImportLens -> Text
jSONString :: Prelude.Text,
    ImportLens -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (ImportLens -> ImportLens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportLens -> ImportLens -> Bool
$c/= :: ImportLens -> ImportLens -> Bool
== :: ImportLens -> ImportLens -> Bool
$c== :: ImportLens -> ImportLens -> Bool
Prelude.Eq, ReadPrec [ImportLens]
ReadPrec ImportLens
Int -> ReadS ImportLens
ReadS [ImportLens]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportLens]
$creadListPrec :: ReadPrec [ImportLens]
readPrec :: ReadPrec ImportLens
$creadPrec :: ReadPrec ImportLens
readList :: ReadS [ImportLens]
$creadList :: ReadS [ImportLens]
readsPrec :: Int -> ReadS ImportLens
$creadsPrec :: Int -> ReadS ImportLens
Prelude.Read, Int -> ImportLens -> ShowS
[ImportLens] -> ShowS
ImportLens -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportLens] -> ShowS
$cshowList :: [ImportLens] -> ShowS
show :: ImportLens -> String
$cshow :: ImportLens -> String
showsPrec :: Int -> ImportLens -> ShowS
$cshowsPrec :: Int -> ImportLens -> ShowS
Prelude.Show, forall x. Rep ImportLens x -> ImportLens
forall x. ImportLens -> Rep ImportLens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportLens x -> ImportLens
$cfrom :: forall x. ImportLens -> Rep ImportLens x
Prelude.Generic)

-- |
-- Create a value of 'ImportLens' 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:
--
-- 'lensAlias', 'importLens_lensAlias' - Undocumented member.
--
-- 'tags', 'importLens_tags' - Tags to associate to a lens.
--
-- 'jSONString', 'importLens_jSONString' - The JSON representation of a lens.
--
-- 'clientRequestToken', 'importLens_clientRequestToken' - Undocumented member.
newImportLens ::
  -- | 'jSONString'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  ImportLens
newImportLens :: Text -> Text -> ImportLens
newImportLens Text
pJSONString_ Text
pClientRequestToken_ =
  ImportLens'
    { $sel:lensAlias:ImportLens' :: Maybe Text
lensAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportLens' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:jSONString:ImportLens' :: Text
jSONString = Text
pJSONString_,
      $sel:clientRequestToken:ImportLens' :: Text
clientRequestToken = Text
pClientRequestToken_
    }

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

-- | Tags to associate to a lens.
importLens_tags :: Lens.Lens' ImportLens (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
importLens_tags :: Lens' ImportLens (Maybe (HashMap Text Text))
importLens_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportLens' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ImportLens' :: ImportLens -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ImportLens
s@ImportLens' {} Maybe (HashMap Text Text)
a -> ImportLens
s {$sel:tags:ImportLens' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ImportLens) 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 forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The JSON representation of a lens.
importLens_jSONString :: Lens.Lens' ImportLens Prelude.Text
importLens_jSONString :: Lens' ImportLens Text
importLens_jSONString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportLens' {Text
jSONString :: Text
$sel:jSONString:ImportLens' :: ImportLens -> Text
jSONString} -> Text
jSONString) (\s :: ImportLens
s@ImportLens' {} Text
a -> ImportLens
s {$sel:jSONString:ImportLens' :: Text
jSONString = Text
a} :: ImportLens)

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

instance Core.AWSRequest ImportLens where
  type AWSResponse ImportLens = ImportLensResponse
  request :: (Service -> Service) -> ImportLens -> Request ImportLens
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ImportLens
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportLens)))
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 ImportLensStatus -> Int -> ImportLensResponse
ImportLensResponse'
            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
"LensArn")
            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 ImportLens where
  hashWithSalt :: Int -> ImportLens -> Int
hashWithSalt Int
_salt ImportLens' {Maybe Text
Maybe (HashMap Text Text)
Text
clientRequestToken :: Text
jSONString :: Text
tags :: Maybe (HashMap Text Text)
lensAlias :: Maybe Text
$sel:clientRequestToken:ImportLens' :: ImportLens -> Text
$sel:jSONString:ImportLens' :: ImportLens -> Text
$sel:tags:ImportLens' :: ImportLens -> Maybe (HashMap Text Text)
$sel:lensAlias:ImportLens' :: ImportLens -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lensAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jSONString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData ImportLens where
  rnf :: ImportLens -> ()
rnf ImportLens' {Maybe Text
Maybe (HashMap Text Text)
Text
clientRequestToken :: Text
jSONString :: Text
tags :: Maybe (HashMap Text Text)
lensAlias :: Maybe Text
$sel:clientRequestToken:ImportLens' :: ImportLens -> Text
$sel:jSONString:ImportLens' :: ImportLens -> Text
$sel:tags:ImportLens' :: ImportLens -> Maybe (HashMap Text Text)
$sel:lensAlias:ImportLens' :: ImportLens -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lensAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jSONString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

instance Data.ToHeaders ImportLens where
  toHeaders :: ImportLens -> 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.ToJSON ImportLens where
  toJSON :: ImportLens -> Value
toJSON ImportLens' {Maybe Text
Maybe (HashMap Text Text)
Text
clientRequestToken :: Text
jSONString :: Text
tags :: Maybe (HashMap Text Text)
lensAlias :: Maybe Text
$sel:clientRequestToken:ImportLens' :: ImportLens -> Text
$sel:jSONString:ImportLens' :: ImportLens -> Text
$sel:tags:ImportLens' :: ImportLens -> Maybe (HashMap Text Text)
$sel:lensAlias:ImportLens' :: ImportLens -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LensAlias" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
lensAlias,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"JSONString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jSONString),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'ImportLensResponse' 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:
--
-- 'lensArn', 'importLensResponse_lensArn' - The ARN for the lens.
--
-- 'status', 'importLensResponse_status' - The status of the imported lens.
--
-- 'httpStatus', 'importLensResponse_httpStatus' - The response's http status code.
newImportLensResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportLensResponse
newImportLensResponse :: Int -> ImportLensResponse
newImportLensResponse Int
pHttpStatus_ =
  ImportLensResponse'
    { $sel:lensArn:ImportLensResponse' :: Maybe Text
lensArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ImportLensResponse' :: Maybe ImportLensStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportLensResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN for the lens.
importLensResponse_lensArn :: Lens.Lens' ImportLensResponse (Prelude.Maybe Prelude.Text)
importLensResponse_lensArn :: Lens' ImportLensResponse (Maybe Text)
importLensResponse_lensArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportLensResponse' {Maybe Text
lensArn :: Maybe Text
$sel:lensArn:ImportLensResponse' :: ImportLensResponse -> Maybe Text
lensArn} -> Maybe Text
lensArn) (\s :: ImportLensResponse
s@ImportLensResponse' {} Maybe Text
a -> ImportLensResponse
s {$sel:lensArn:ImportLensResponse' :: Maybe Text
lensArn = Maybe Text
a} :: ImportLensResponse)

-- | The status of the imported lens.
importLensResponse_status :: Lens.Lens' ImportLensResponse (Prelude.Maybe ImportLensStatus)
importLensResponse_status :: Lens' ImportLensResponse (Maybe ImportLensStatus)
importLensResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportLensResponse' {Maybe ImportLensStatus
status :: Maybe ImportLensStatus
$sel:status:ImportLensResponse' :: ImportLensResponse -> Maybe ImportLensStatus
status} -> Maybe ImportLensStatus
status) (\s :: ImportLensResponse
s@ImportLensResponse' {} Maybe ImportLensStatus
a -> ImportLensResponse
s {$sel:status:ImportLensResponse' :: Maybe ImportLensStatus
status = Maybe ImportLensStatus
a} :: ImportLensResponse)

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

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