{-# 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.Route53Domains.UpdateTagsForDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation adds or updates tags for a specified domain.
--
-- All tag operations are eventually consistent; subsequent operations
-- might not immediately represent all issued operations.
module Amazonka.Route53Domains.UpdateTagsForDomain
  ( -- * Creating a Request
    UpdateTagsForDomain (..),
    newUpdateTagsForDomain,

    -- * Request Lenses
    updateTagsForDomain_tagsToUpdate,
    updateTagsForDomain_domainName,

    -- * Destructuring the Response
    UpdateTagsForDomainResponse (..),
    newUpdateTagsForDomainResponse,

    -- * Response Lenses
    updateTagsForDomainResponse_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.Route53Domains.Types

-- | The UpdateTagsForDomainRequest includes the following elements.
--
-- /See:/ 'newUpdateTagsForDomain' smart constructor.
data UpdateTagsForDomain = UpdateTagsForDomain'
  { -- | A list of the tag keys and values that you want to add or update. If you
    -- specify a key that already exists, the corresponding value will be
    -- replaced.
    UpdateTagsForDomain -> Maybe [Tag]
tagsToUpdate :: Prelude.Maybe [Tag],
    -- | The domain for which you want to add or update tags.
    UpdateTagsForDomain -> Text
domainName :: Prelude.Text
  }
  deriving (UpdateTagsForDomain -> UpdateTagsForDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTagsForDomain -> UpdateTagsForDomain -> Bool
$c/= :: UpdateTagsForDomain -> UpdateTagsForDomain -> Bool
== :: UpdateTagsForDomain -> UpdateTagsForDomain -> Bool
$c== :: UpdateTagsForDomain -> UpdateTagsForDomain -> Bool
Prelude.Eq, ReadPrec [UpdateTagsForDomain]
ReadPrec UpdateTagsForDomain
Int -> ReadS UpdateTagsForDomain
ReadS [UpdateTagsForDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTagsForDomain]
$creadListPrec :: ReadPrec [UpdateTagsForDomain]
readPrec :: ReadPrec UpdateTagsForDomain
$creadPrec :: ReadPrec UpdateTagsForDomain
readList :: ReadS [UpdateTagsForDomain]
$creadList :: ReadS [UpdateTagsForDomain]
readsPrec :: Int -> ReadS UpdateTagsForDomain
$creadsPrec :: Int -> ReadS UpdateTagsForDomain
Prelude.Read, Int -> UpdateTagsForDomain -> ShowS
[UpdateTagsForDomain] -> ShowS
UpdateTagsForDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTagsForDomain] -> ShowS
$cshowList :: [UpdateTagsForDomain] -> ShowS
show :: UpdateTagsForDomain -> String
$cshow :: UpdateTagsForDomain -> String
showsPrec :: Int -> UpdateTagsForDomain -> ShowS
$cshowsPrec :: Int -> UpdateTagsForDomain -> ShowS
Prelude.Show, forall x. Rep UpdateTagsForDomain x -> UpdateTagsForDomain
forall x. UpdateTagsForDomain -> Rep UpdateTagsForDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTagsForDomain x -> UpdateTagsForDomain
$cfrom :: forall x. UpdateTagsForDomain -> Rep UpdateTagsForDomain x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTagsForDomain' 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:
--
-- 'tagsToUpdate', 'updateTagsForDomain_tagsToUpdate' - A list of the tag keys and values that you want to add or update. If you
-- specify a key that already exists, the corresponding value will be
-- replaced.
--
-- 'domainName', 'updateTagsForDomain_domainName' - The domain for which you want to add or update tags.
newUpdateTagsForDomain ::
  -- | 'domainName'
  Prelude.Text ->
  UpdateTagsForDomain
newUpdateTagsForDomain :: Text -> UpdateTagsForDomain
newUpdateTagsForDomain Text
pDomainName_ =
  UpdateTagsForDomain'
    { $sel:tagsToUpdate:UpdateTagsForDomain' :: Maybe [Tag]
tagsToUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:UpdateTagsForDomain' :: Text
domainName = Text
pDomainName_
    }

-- | A list of the tag keys and values that you want to add or update. If you
-- specify a key that already exists, the corresponding value will be
-- replaced.
updateTagsForDomain_tagsToUpdate :: Lens.Lens' UpdateTagsForDomain (Prelude.Maybe [Tag])
updateTagsForDomain_tagsToUpdate :: Lens' UpdateTagsForDomain (Maybe [Tag])
updateTagsForDomain_tagsToUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTagsForDomain' {Maybe [Tag]
tagsToUpdate :: Maybe [Tag]
$sel:tagsToUpdate:UpdateTagsForDomain' :: UpdateTagsForDomain -> Maybe [Tag]
tagsToUpdate} -> Maybe [Tag]
tagsToUpdate) (\s :: UpdateTagsForDomain
s@UpdateTagsForDomain' {} Maybe [Tag]
a -> UpdateTagsForDomain
s {$sel:tagsToUpdate:UpdateTagsForDomain' :: Maybe [Tag]
tagsToUpdate = Maybe [Tag]
a} :: UpdateTagsForDomain) 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 domain for which you want to add or update tags.
updateTagsForDomain_domainName :: Lens.Lens' UpdateTagsForDomain Prelude.Text
updateTagsForDomain_domainName :: Lens' UpdateTagsForDomain Text
updateTagsForDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTagsForDomain' {Text
domainName :: Text
$sel:domainName:UpdateTagsForDomain' :: UpdateTagsForDomain -> Text
domainName} -> Text
domainName) (\s :: UpdateTagsForDomain
s@UpdateTagsForDomain' {} Text
a -> UpdateTagsForDomain
s {$sel:domainName:UpdateTagsForDomain' :: Text
domainName = Text
a} :: UpdateTagsForDomain)

instance Core.AWSRequest UpdateTagsForDomain where
  type
    AWSResponse UpdateTagsForDomain =
      UpdateTagsForDomainResponse
  request :: (Service -> Service)
-> UpdateTagsForDomain -> Request UpdateTagsForDomain
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateTagsForDomain
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateTagsForDomain)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateTagsForDomainResponse
UpdateTagsForDomainResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateTagsForDomain where
  hashWithSalt :: Int -> UpdateTagsForDomain -> Int
hashWithSalt Int
_salt UpdateTagsForDomain' {Maybe [Tag]
Text
domainName :: Text
tagsToUpdate :: Maybe [Tag]
$sel:domainName:UpdateTagsForDomain' :: UpdateTagsForDomain -> Text
$sel:tagsToUpdate:UpdateTagsForDomain' :: UpdateTagsForDomain -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tagsToUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData UpdateTagsForDomain where
  rnf :: UpdateTagsForDomain -> ()
rnf UpdateTagsForDomain' {Maybe [Tag]
Text
domainName :: Text
tagsToUpdate :: Maybe [Tag]
$sel:domainName:UpdateTagsForDomain' :: UpdateTagsForDomain -> Text
$sel:tagsToUpdate:UpdateTagsForDomain' :: UpdateTagsForDomain -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tagsToUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders UpdateTagsForDomain where
  toHeaders :: UpdateTagsForDomain -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Route53Domains_v20140515.UpdateTagsForDomain" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateTagsForDomain where
  toJSON :: UpdateTagsForDomain -> Value
toJSON UpdateTagsForDomain' {Maybe [Tag]
Text
domainName :: Text
tagsToUpdate :: Maybe [Tag]
$sel:domainName:UpdateTagsForDomain' :: UpdateTagsForDomain -> Text
$sel:tagsToUpdate:UpdateTagsForDomain' :: UpdateTagsForDomain -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"TagsToUpdate" 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 [Tag]
tagsToUpdate,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateTagsForDomainResponse' 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:
--
-- 'httpStatus', 'updateTagsForDomainResponse_httpStatus' - The response's http status code.
newUpdateTagsForDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTagsForDomainResponse
newUpdateTagsForDomainResponse :: Int -> UpdateTagsForDomainResponse
newUpdateTagsForDomainResponse Int
pHttpStatus_ =
  UpdateTagsForDomainResponse'
    { $sel:httpStatus:UpdateTagsForDomainResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateTagsForDomainResponse where
  rnf :: UpdateTagsForDomainResponse -> ()
rnf UpdateTagsForDomainResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateTagsForDomainResponse' :: UpdateTagsForDomainResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus