{-# 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.Lightsail.TagResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more tags to the specified Amazon Lightsail resource. Each
-- resource can have a maximum of 50 tags. Each tag consists of a key and
-- an optional value. Tag keys must be unique per resource. For more
-- information about tags, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-tags Amazon Lightsail Developer Guide>.
--
-- The @tag resource@ operation supports tag-based access control via
-- request tags and resource tags applied to the resource identified by
-- @resource name@. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.TagResource
  ( -- * Creating a Request
    TagResource (..),
    newTagResource,

    -- * Request Lenses
    tagResource_resourceArn,
    tagResource_resourceName,
    tagResource_tags,

    -- * Destructuring the Response
    TagResourceResponse (..),
    newTagResourceResponse,

    -- * Response Lenses
    tagResourceResponse_operations,
    tagResourceResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTagResource' smart constructor.
data TagResource = TagResource'
  { -- | The Amazon Resource Name (ARN) of the resource to which you want to add
    -- a tag.
    TagResource -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the resource to which you are adding tags.
    TagResource -> Text
resourceName :: Prelude.Text,
    -- | The tag key and optional value.
    TagResource -> [Tag]
tags :: [Tag]
  }
  deriving (TagResource -> TagResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagResource -> TagResource -> Bool
$c/= :: TagResource -> TagResource -> Bool
== :: TagResource -> TagResource -> Bool
$c== :: TagResource -> TagResource -> Bool
Prelude.Eq, ReadPrec [TagResource]
ReadPrec TagResource
Int -> ReadS TagResource
ReadS [TagResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagResource]
$creadListPrec :: ReadPrec [TagResource]
readPrec :: ReadPrec TagResource
$creadPrec :: ReadPrec TagResource
readList :: ReadS [TagResource]
$creadList :: ReadS [TagResource]
readsPrec :: Int -> ReadS TagResource
$creadsPrec :: Int -> ReadS TagResource
Prelude.Read, Int -> TagResource -> ShowS
[TagResource] -> ShowS
TagResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagResource] -> ShowS
$cshowList :: [TagResource] -> ShowS
show :: TagResource -> String
$cshow :: TagResource -> String
showsPrec :: Int -> TagResource -> ShowS
$cshowsPrec :: Int -> TagResource -> ShowS
Prelude.Show, forall x. Rep TagResource x -> TagResource
forall x. TagResource -> Rep TagResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagResource x -> TagResource
$cfrom :: forall x. TagResource -> Rep TagResource x
Prelude.Generic)

-- |
-- Create a value of 'TagResource' 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:
--
-- 'resourceArn', 'tagResource_resourceArn' - The Amazon Resource Name (ARN) of the resource to which you want to add
-- a tag.
--
-- 'resourceName', 'tagResource_resourceName' - The name of the resource to which you are adding tags.
--
-- 'tags', 'tagResource_tags' - The tag key and optional value.
newTagResource ::
  -- | 'resourceName'
  Prelude.Text ->
  TagResource
newTagResource :: Text -> TagResource
newTagResource Text
pResourceName_ =
  TagResource'
    { $sel:resourceArn:TagResource' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceName:TagResource' :: Text
resourceName = Text
pResourceName_,
      $sel:tags:TagResource' :: [Tag]
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | The Amazon Resource Name (ARN) of the resource to which you want to add
-- a tag.
tagResource_resourceArn :: Lens.Lens' TagResource (Prelude.Maybe Prelude.Text)
tagResource_resourceArn :: Lens' TagResource (Maybe Text)
tagResource_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResource' {Maybe Text
resourceArn :: Maybe Text
$sel:resourceArn:TagResource' :: TagResource -> Maybe Text
resourceArn} -> Maybe Text
resourceArn) (\s :: TagResource
s@TagResource' {} Maybe Text
a -> TagResource
s {$sel:resourceArn:TagResource' :: Maybe Text
resourceArn = Maybe Text
a} :: TagResource)

-- | The name of the resource to which you are adding tags.
tagResource_resourceName :: Lens.Lens' TagResource Prelude.Text
tagResource_resourceName :: Lens' TagResource Text
tagResource_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResource' {Text
resourceName :: Text
$sel:resourceName:TagResource' :: TagResource -> Text
resourceName} -> Text
resourceName) (\s :: TagResource
s@TagResource' {} Text
a -> TagResource
s {$sel:resourceName:TagResource' :: Text
resourceName = Text
a} :: TagResource)

-- | The tag key and optional value.
tagResource_tags :: Lens.Lens' TagResource [Tag]
tagResource_tags :: Lens' TagResource [Tag]
tagResource_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResource' {[Tag]
tags :: [Tag]
$sel:tags:TagResource' :: TagResource -> [Tag]
tags} -> [Tag]
tags) (\s :: TagResource
s@TagResource' {} [Tag]
a -> TagResource
s {$sel:tags:TagResource' :: [Tag]
tags = [Tag]
a} :: TagResource) 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 TagResource where
  type AWSResponse TagResource = TagResourceResponse
  request :: (Service -> Service) -> TagResource -> Request TagResource
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 TagResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TagResource)))
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 [Operation] -> Int -> TagResourceResponse
TagResourceResponse'
            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
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 TagResource where
  hashWithSalt :: Int -> TagResource -> Int
hashWithSalt Int
_salt TagResource' {[Tag]
Maybe Text
Text
tags :: [Tag]
resourceName :: Text
resourceArn :: Maybe Text
$sel:tags:TagResource' :: TagResource -> [Tag]
$sel:resourceName:TagResource' :: TagResource -> Text
$sel:resourceArn:TagResource' :: TagResource -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Tag]
tags

instance Prelude.NFData TagResource where
  rnf :: TagResource -> ()
rnf TagResource' {[Tag]
Maybe Text
Text
tags :: [Tag]
resourceName :: Text
resourceArn :: Maybe Text
$sel:tags:TagResource' :: TagResource -> [Tag]
$sel:resourceName:TagResource' :: TagResource -> Text
$sel:resourceArn:TagResource' :: TagResource -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Tag]
tags

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

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

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

-- | /See:/ 'newTagResourceResponse' smart constructor.
data TagResourceResponse = TagResourceResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    TagResourceResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    TagResourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TagResourceResponse -> TagResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagResourceResponse -> TagResourceResponse -> Bool
$c/= :: TagResourceResponse -> TagResourceResponse -> Bool
== :: TagResourceResponse -> TagResourceResponse -> Bool
$c== :: TagResourceResponse -> TagResourceResponse -> Bool
Prelude.Eq, ReadPrec [TagResourceResponse]
ReadPrec TagResourceResponse
Int -> ReadS TagResourceResponse
ReadS [TagResourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagResourceResponse]
$creadListPrec :: ReadPrec [TagResourceResponse]
readPrec :: ReadPrec TagResourceResponse
$creadPrec :: ReadPrec TagResourceResponse
readList :: ReadS [TagResourceResponse]
$creadList :: ReadS [TagResourceResponse]
readsPrec :: Int -> ReadS TagResourceResponse
$creadsPrec :: Int -> ReadS TagResourceResponse
Prelude.Read, Int -> TagResourceResponse -> ShowS
[TagResourceResponse] -> ShowS
TagResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagResourceResponse] -> ShowS
$cshowList :: [TagResourceResponse] -> ShowS
show :: TagResourceResponse -> String
$cshow :: TagResourceResponse -> String
showsPrec :: Int -> TagResourceResponse -> ShowS
$cshowsPrec :: Int -> TagResourceResponse -> ShowS
Prelude.Show, forall x. Rep TagResourceResponse x -> TagResourceResponse
forall x. TagResourceResponse -> Rep TagResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagResourceResponse x -> TagResourceResponse
$cfrom :: forall x. TagResourceResponse -> Rep TagResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'TagResourceResponse' 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:
--
-- 'operations', 'tagResourceResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'tagResourceResponse_httpStatus' - The response's http status code.
newTagResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TagResourceResponse
newTagResourceResponse :: Int -> TagResourceResponse
newTagResourceResponse Int
pHttpStatus_ =
  TagResourceResponse'
    { $sel:operations:TagResourceResponse' :: Maybe [Operation]
operations = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TagResourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
tagResourceResponse_operations :: Lens.Lens' TagResourceResponse (Prelude.Maybe [Operation])
tagResourceResponse_operations :: Lens' TagResourceResponse (Maybe [Operation])
tagResourceResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResourceResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:TagResourceResponse' :: TagResourceResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: TagResourceResponse
s@TagResourceResponse' {} Maybe [Operation]
a -> TagResourceResponse
s {$sel:operations:TagResourceResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: TagResourceResponse) 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 response's http status code.
tagResourceResponse_httpStatus :: Lens.Lens' TagResourceResponse Prelude.Int
tagResourceResponse_httpStatus :: Lens' TagResourceResponse Int
tagResourceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResourceResponse' {Int
httpStatus :: Int
$sel:httpStatus:TagResourceResponse' :: TagResourceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: TagResourceResponse
s@TagResourceResponse' {} Int
a -> TagResourceResponse
s {$sel:httpStatus:TagResourceResponse' :: Int
httpStatus = Int
a} :: TagResourceResponse)

instance Prelude.NFData TagResourceResponse where
  rnf :: TagResourceResponse -> ()
rnf TagResourceResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:TagResourceResponse' :: TagResourceResponse -> Int
$sel:operations:TagResourceResponse' :: TagResourceResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus