{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EC2.Types.TagSpecification
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.TagSpecification where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.ResourceType
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | The tags to apply to a resource when the resource is being created.
--
-- The @Valid Values@ lists all the resource types that can be tagged.
-- However, the action you\'re using might not support tagging all of these
-- resource types. If you try to tag a resource type that is unsupported
-- for the action you\'re using, you\'ll get an error.
--
-- /See:/ 'newTagSpecification' smart constructor.
data TagSpecification = TagSpecification'
  { -- | The type of resource to tag on creation.
    TagSpecification -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    -- | The tags to apply to the resource.
    TagSpecification -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (TagSpecification -> TagSpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagSpecification -> TagSpecification -> Bool
$c/= :: TagSpecification -> TagSpecification -> Bool
== :: TagSpecification -> TagSpecification -> Bool
$c== :: TagSpecification -> TagSpecification -> Bool
Prelude.Eq, ReadPrec [TagSpecification]
ReadPrec TagSpecification
Int -> ReadS TagSpecification
ReadS [TagSpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagSpecification]
$creadListPrec :: ReadPrec [TagSpecification]
readPrec :: ReadPrec TagSpecification
$creadPrec :: ReadPrec TagSpecification
readList :: ReadS [TagSpecification]
$creadList :: ReadS [TagSpecification]
readsPrec :: Int -> ReadS TagSpecification
$creadsPrec :: Int -> ReadS TagSpecification
Prelude.Read, Int -> TagSpecification -> ShowS
[TagSpecification] -> ShowS
TagSpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagSpecification] -> ShowS
$cshowList :: [TagSpecification] -> ShowS
show :: TagSpecification -> String
$cshow :: TagSpecification -> String
showsPrec :: Int -> TagSpecification -> ShowS
$cshowsPrec :: Int -> TagSpecification -> ShowS
Prelude.Show, forall x. Rep TagSpecification x -> TagSpecification
forall x. TagSpecification -> Rep TagSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagSpecification x -> TagSpecification
$cfrom :: forall x. TagSpecification -> Rep TagSpecification x
Prelude.Generic)

-- |
-- Create a value of 'TagSpecification' 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:
--
-- 'resourceType', 'tagSpecification_resourceType' - The type of resource to tag on creation.
--
-- 'tags', 'tagSpecification_tags' - The tags to apply to the resource.
newTagSpecification ::
  TagSpecification
newTagSpecification :: TagSpecification
newTagSpecification =
  TagSpecification'
    { $sel:resourceType:TagSpecification' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:TagSpecification' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The type of resource to tag on creation.
tagSpecification_resourceType :: Lens.Lens' TagSpecification (Prelude.Maybe ResourceType)
tagSpecification_resourceType :: Lens' TagSpecification (Maybe ResourceType)
tagSpecification_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagSpecification' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:TagSpecification' :: TagSpecification -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: TagSpecification
s@TagSpecification' {} Maybe ResourceType
a -> TagSpecification
s {$sel:resourceType:TagSpecification' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: TagSpecification)

-- | The tags to apply to the resource.
tagSpecification_tags :: Lens.Lens' TagSpecification (Prelude.Maybe [Tag])
tagSpecification_tags :: Lens' TagSpecification (Maybe [Tag])
tagSpecification_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagSpecification' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:TagSpecification' :: TagSpecification -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: TagSpecification
s@TagSpecification' {} Maybe [Tag]
a -> TagSpecification
s {$sel:tags:TagSpecification' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: TagSpecification) 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

instance Data.FromXML TagSpecification where
  parseXML :: [Node] -> Either String TagSpecification
parseXML [Node]
x =
    Maybe ResourceType -> Maybe [Tag] -> TagSpecification
TagSpecification'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"resourceType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Tag"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )

instance Prelude.Hashable TagSpecification where
  hashWithSalt :: Int -> TagSpecification -> Int
hashWithSalt Int
_salt TagSpecification' {Maybe [Tag]
Maybe ResourceType
tags :: Maybe [Tag]
resourceType :: Maybe ResourceType
$sel:tags:TagSpecification' :: TagSpecification -> Maybe [Tag]
$sel:resourceType:TagSpecification' :: TagSpecification -> Maybe ResourceType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData TagSpecification where
  rnf :: TagSpecification -> ()
rnf TagSpecification' {Maybe [Tag]
Maybe ResourceType
tags :: Maybe [Tag]
resourceType :: Maybe ResourceType
$sel:tags:TagSpecification' :: TagSpecification -> Maybe [Tag]
$sel:resourceType:TagSpecification' :: TagSpecification -> Maybe ResourceType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags

instance Data.ToQuery TagSpecification where
  toQuery :: TagSpecification -> QueryString
toQuery TagSpecification' {Maybe [Tag]
Maybe ResourceType
tags :: Maybe [Tag]
resourceType :: Maybe ResourceType
$sel:tags:TagSpecification' :: TagSpecification -> Maybe [Tag]
$sel:resourceType:TagSpecification' :: TagSpecification -> Maybe ResourceType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"ResourceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ResourceType
resourceType,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags)
      ]