{-# 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.AssociateLenses
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associate a lens to a workload.
--
-- Up to 10 lenses can be associated with a workload in a single API
-- operation. A maximum of 20 lenses can be associated with a workload.
--
-- __Disclaimer__
--
-- By accessing and\/or applying custom lenses created by another Amazon
-- Web Services user or account, you acknowledge that custom lenses created
-- by other users and shared with you are Third Party Content as defined in
-- the Amazon Web Services Customer Agreement.
module Amazonka.WellArchitected.AssociateLenses
  ( -- * Creating a Request
    AssociateLenses (..),
    newAssociateLenses,

    -- * Request Lenses
    associateLenses_workloadId,
    associateLenses_lensAliases,

    -- * Destructuring the Response
    AssociateLensesResponse (..),
    newAssociateLensesResponse,
  )
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

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

-- |
-- Create a value of 'AssociateLenses' 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:
--
-- 'workloadId', 'associateLenses_workloadId' - Undocumented member.
--
-- 'lensAliases', 'associateLenses_lensAliases' - Undocumented member.
newAssociateLenses ::
  -- | 'workloadId'
  Prelude.Text ->
  -- | 'lensAliases'
  Prelude.NonEmpty Prelude.Text ->
  AssociateLenses
newAssociateLenses :: Text -> NonEmpty Text -> AssociateLenses
newAssociateLenses Text
pWorkloadId_ NonEmpty Text
pLensAliases_ =
  AssociateLenses'
    { $sel:workloadId:AssociateLenses' :: Text
workloadId = Text
pWorkloadId_,
      $sel:lensAliases:AssociateLenses' :: NonEmpty Text
lensAliases = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pLensAliases_
    }

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

-- | Undocumented member.
associateLenses_lensAliases :: Lens.Lens' AssociateLenses (Prelude.NonEmpty Prelude.Text)
associateLenses_lensAliases :: Lens' AssociateLenses (NonEmpty Text)
associateLenses_lensAliases = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateLenses' {NonEmpty Text
lensAliases :: NonEmpty Text
$sel:lensAliases:AssociateLenses' :: AssociateLenses -> NonEmpty Text
lensAliases} -> NonEmpty Text
lensAliases) (\s :: AssociateLenses
s@AssociateLenses' {} NonEmpty Text
a -> AssociateLenses
s {$sel:lensAliases:AssociateLenses' :: NonEmpty Text
lensAliases = NonEmpty Text
a} :: AssociateLenses) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest AssociateLenses where
  type
    AWSResponse AssociateLenses =
      AssociateLensesResponse
  request :: (Service -> Service) -> AssociateLenses -> Request AssociateLenses
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AssociateLenses
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AssociateLenses)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull AssociateLensesResponse
AssociateLensesResponse'

instance Prelude.Hashable AssociateLenses where
  hashWithSalt :: Int -> AssociateLenses -> Int
hashWithSalt Int
_salt AssociateLenses' {NonEmpty Text
Text
lensAliases :: NonEmpty Text
workloadId :: Text
$sel:lensAliases:AssociateLenses' :: AssociateLenses -> NonEmpty Text
$sel:workloadId:AssociateLenses' :: AssociateLenses -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
lensAliases

instance Prelude.NFData AssociateLenses where
  rnf :: AssociateLenses -> ()
rnf AssociateLenses' {NonEmpty Text
Text
lensAliases :: NonEmpty Text
workloadId :: Text
$sel:lensAliases:AssociateLenses' :: AssociateLenses -> NonEmpty Text
$sel:workloadId:AssociateLenses' :: AssociateLenses -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workloadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
lensAliases

instance Data.ToHeaders AssociateLenses where
  toHeaders :: AssociateLenses -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AssociateLenses where
  toJSON :: AssociateLenses -> Value
toJSON AssociateLenses' {NonEmpty Text
Text
lensAliases :: NonEmpty Text
workloadId :: Text
$sel:lensAliases:AssociateLenses' :: AssociateLenses -> NonEmpty Text
$sel:workloadId:AssociateLenses' :: AssociateLenses -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"LensAliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
lensAliases)]
      )

instance Data.ToPath AssociateLenses where
  toPath :: AssociateLenses -> ByteString
toPath AssociateLenses' {NonEmpty Text
Text
lensAliases :: NonEmpty Text
workloadId :: Text
$sel:lensAliases:AssociateLenses' :: AssociateLenses -> NonEmpty Text
$sel:workloadId:AssociateLenses' :: AssociateLenses -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workloads/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workloadId,
        ByteString
"/associateLenses"
      ]

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

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

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

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