{-# 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.ServiceCatalogAppRegistry.PutConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a @TagKey@ configuration to an account.
module Amazonka.ServiceCatalogAppRegistry.PutConfiguration
  ( -- * Creating a Request
    PutConfiguration (..),
    newPutConfiguration,

    -- * Request Lenses
    putConfiguration_configuration,

    -- * Destructuring the Response
    PutConfigurationResponse (..),
    newPutConfigurationResponse,
  )
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.ServiceCatalogAppRegistry.Types

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

-- |
-- Create a value of 'PutConfiguration' 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:
--
-- 'configuration', 'putConfiguration_configuration' - Associates a @TagKey@ configuration to an account.
newPutConfiguration ::
  -- | 'configuration'
  AppRegistryConfiguration ->
  PutConfiguration
newPutConfiguration :: AppRegistryConfiguration -> PutConfiguration
newPutConfiguration AppRegistryConfiguration
pConfiguration_ =
  PutConfiguration' {$sel:configuration:PutConfiguration' :: AppRegistryConfiguration
configuration = AppRegistryConfiguration
pConfiguration_}

-- | Associates a @TagKey@ configuration to an account.
putConfiguration_configuration :: Lens.Lens' PutConfiguration AppRegistryConfiguration
putConfiguration_configuration :: Lens' PutConfiguration AppRegistryConfiguration
putConfiguration_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfiguration' {AppRegistryConfiguration
configuration :: AppRegistryConfiguration
$sel:configuration:PutConfiguration' :: PutConfiguration -> AppRegistryConfiguration
configuration} -> AppRegistryConfiguration
configuration) (\s :: PutConfiguration
s@PutConfiguration' {} AppRegistryConfiguration
a -> PutConfiguration
s {$sel:configuration:PutConfiguration' :: AppRegistryConfiguration
configuration = AppRegistryConfiguration
a} :: PutConfiguration)

instance Core.AWSRequest PutConfiguration where
  type
    AWSResponse PutConfiguration =
      PutConfigurationResponse
  request :: (Service -> Service)
-> PutConfiguration -> Request PutConfiguration
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 PutConfiguration
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutConfigurationResponse
PutConfigurationResponse'

instance Prelude.Hashable PutConfiguration where
  hashWithSalt :: Int -> PutConfiguration -> Int
hashWithSalt Int
_salt PutConfiguration' {AppRegistryConfiguration
configuration :: AppRegistryConfiguration
$sel:configuration:PutConfiguration' :: PutConfiguration -> AppRegistryConfiguration
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AppRegistryConfiguration
configuration

instance Prelude.NFData PutConfiguration where
  rnf :: PutConfiguration -> ()
rnf PutConfiguration' {AppRegistryConfiguration
configuration :: AppRegistryConfiguration
$sel:configuration:PutConfiguration' :: PutConfiguration -> AppRegistryConfiguration
..} = forall a. NFData a => a -> ()
Prelude.rnf AppRegistryConfiguration
configuration

instance Data.ToHeaders PutConfiguration where
  toHeaders :: PutConfiguration -> [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 PutConfiguration where
  toJSON :: PutConfiguration -> Value
toJSON PutConfiguration' {AppRegistryConfiguration
configuration :: AppRegistryConfiguration
$sel:configuration:PutConfiguration' :: PutConfiguration -> AppRegistryConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"configuration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AppRegistryConfiguration
configuration)
          ]
      )

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

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

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

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

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