{-# 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.EC2.ModifyIdFormat
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the ID format for the specified resource on a per-Region basis.
-- You can specify that resources should receive longer IDs (17-character
-- IDs) when they are created.
--
-- This request can only be used to modify longer ID settings for resource
-- types that are within the opt-in period. Resources currently in their
-- opt-in period include: @bundle@ | @conversion-task@ | @customer-gateway@
-- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
-- @export-task@ | @flow-log@ | @image@ | @import-task@ |
-- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
-- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
-- @route-table@ | @route-table-association@ | @security-group@ | @subnet@
-- | @subnet-cidr-block-association@ | @vpc@ | @vpc-cidr-block-association@
-- | @vpc-endpoint@ | @vpc-peering-connection@ | @vpn-connection@ |
-- @vpn-gateway@.
--
-- This setting applies to the IAM user who makes the request; it does not
-- apply to the entire Amazon Web Services account. By default, an IAM user
-- defaults to the same settings as the root user. If you\'re using this
-- action as the root user, then these settings apply to the entire
-- account, unless an IAM user explicitly overrides these settings for
-- themselves. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/resource-ids.html Resource IDs>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Resources created with longer IDs are visible to all IAM roles and
-- users, regardless of these settings and provided that they have
-- permission to use the relevant @Describe@ command for the resource type.
module Amazonka.EC2.ModifyIdFormat
  ( -- * Creating a Request
    ModifyIdFormat (..),
    newModifyIdFormat,

    -- * Request Lenses
    modifyIdFormat_resource,
    modifyIdFormat_useLongIds,

    -- * Destructuring the Response
    ModifyIdFormatResponse (..),
    newModifyIdFormatResponse,
  )
where

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

-- | /See:/ 'newModifyIdFormat' smart constructor.
data ModifyIdFormat = ModifyIdFormat'
  { -- | The type of resource: @bundle@ | @conversion-task@ | @customer-gateway@
    -- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
    -- @export-task@ | @flow-log@ | @image@ | @import-task@ |
    -- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
    -- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
    -- @route-table@ | @route-table-association@ | @security-group@ | @subnet@
    -- | @subnet-cidr-block-association@ | @vpc@ | @vpc-cidr-block-association@
    -- | @vpc-endpoint@ | @vpc-peering-connection@ | @vpn-connection@ |
    -- @vpn-gateway@.
    --
    -- Alternatively, use the @all-current@ option to include all resource
    -- types that are currently within their opt-in period for longer IDs.
    ModifyIdFormat -> Text
resource :: Prelude.Text,
    -- | Indicate whether the resource should use longer IDs (17-character IDs).
    ModifyIdFormat -> Bool
useLongIds :: Prelude.Bool
  }
  deriving (ModifyIdFormat -> ModifyIdFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyIdFormat -> ModifyIdFormat -> Bool
$c/= :: ModifyIdFormat -> ModifyIdFormat -> Bool
== :: ModifyIdFormat -> ModifyIdFormat -> Bool
$c== :: ModifyIdFormat -> ModifyIdFormat -> Bool
Prelude.Eq, ReadPrec [ModifyIdFormat]
ReadPrec ModifyIdFormat
Int -> ReadS ModifyIdFormat
ReadS [ModifyIdFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyIdFormat]
$creadListPrec :: ReadPrec [ModifyIdFormat]
readPrec :: ReadPrec ModifyIdFormat
$creadPrec :: ReadPrec ModifyIdFormat
readList :: ReadS [ModifyIdFormat]
$creadList :: ReadS [ModifyIdFormat]
readsPrec :: Int -> ReadS ModifyIdFormat
$creadsPrec :: Int -> ReadS ModifyIdFormat
Prelude.Read, Int -> ModifyIdFormat -> ShowS
[ModifyIdFormat] -> ShowS
ModifyIdFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyIdFormat] -> ShowS
$cshowList :: [ModifyIdFormat] -> ShowS
show :: ModifyIdFormat -> String
$cshow :: ModifyIdFormat -> String
showsPrec :: Int -> ModifyIdFormat -> ShowS
$cshowsPrec :: Int -> ModifyIdFormat -> ShowS
Prelude.Show, forall x. Rep ModifyIdFormat x -> ModifyIdFormat
forall x. ModifyIdFormat -> Rep ModifyIdFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyIdFormat x -> ModifyIdFormat
$cfrom :: forall x. ModifyIdFormat -> Rep ModifyIdFormat x
Prelude.Generic)

-- |
-- Create a value of 'ModifyIdFormat' 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:
--
-- 'resource', 'modifyIdFormat_resource' - The type of resource: @bundle@ | @conversion-task@ | @customer-gateway@
-- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
-- @export-task@ | @flow-log@ | @image@ | @import-task@ |
-- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
-- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
-- @route-table@ | @route-table-association@ | @security-group@ | @subnet@
-- | @subnet-cidr-block-association@ | @vpc@ | @vpc-cidr-block-association@
-- | @vpc-endpoint@ | @vpc-peering-connection@ | @vpn-connection@ |
-- @vpn-gateway@.
--
-- Alternatively, use the @all-current@ option to include all resource
-- types that are currently within their opt-in period for longer IDs.
--
-- 'useLongIds', 'modifyIdFormat_useLongIds' - Indicate whether the resource should use longer IDs (17-character IDs).
newModifyIdFormat ::
  -- | 'resource'
  Prelude.Text ->
  -- | 'useLongIds'
  Prelude.Bool ->
  ModifyIdFormat
newModifyIdFormat :: Text -> Bool -> ModifyIdFormat
newModifyIdFormat Text
pResource_ Bool
pUseLongIds_ =
  ModifyIdFormat'
    { $sel:resource:ModifyIdFormat' :: Text
resource = Text
pResource_,
      $sel:useLongIds:ModifyIdFormat' :: Bool
useLongIds = Bool
pUseLongIds_
    }

-- | The type of resource: @bundle@ | @conversion-task@ | @customer-gateway@
-- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
-- @export-task@ | @flow-log@ | @image@ | @import-task@ |
-- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
-- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
-- @route-table@ | @route-table-association@ | @security-group@ | @subnet@
-- | @subnet-cidr-block-association@ | @vpc@ | @vpc-cidr-block-association@
-- | @vpc-endpoint@ | @vpc-peering-connection@ | @vpn-connection@ |
-- @vpn-gateway@.
--
-- Alternatively, use the @all-current@ option to include all resource
-- types that are currently within their opt-in period for longer IDs.
modifyIdFormat_resource :: Lens.Lens' ModifyIdFormat Prelude.Text
modifyIdFormat_resource :: Lens' ModifyIdFormat Text
modifyIdFormat_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyIdFormat' {Text
resource :: Text
$sel:resource:ModifyIdFormat' :: ModifyIdFormat -> Text
resource} -> Text
resource) (\s :: ModifyIdFormat
s@ModifyIdFormat' {} Text
a -> ModifyIdFormat
s {$sel:resource:ModifyIdFormat' :: Text
resource = Text
a} :: ModifyIdFormat)

-- | Indicate whether the resource should use longer IDs (17-character IDs).
modifyIdFormat_useLongIds :: Lens.Lens' ModifyIdFormat Prelude.Bool
modifyIdFormat_useLongIds :: Lens' ModifyIdFormat Bool
modifyIdFormat_useLongIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyIdFormat' {Bool
useLongIds :: Bool
$sel:useLongIds:ModifyIdFormat' :: ModifyIdFormat -> Bool
useLongIds} -> Bool
useLongIds) (\s :: ModifyIdFormat
s@ModifyIdFormat' {} Bool
a -> ModifyIdFormat
s {$sel:useLongIds:ModifyIdFormat' :: Bool
useLongIds = Bool
a} :: ModifyIdFormat)

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

instance Prelude.Hashable ModifyIdFormat where
  hashWithSalt :: Int -> ModifyIdFormat -> Int
hashWithSalt Int
_salt ModifyIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
$sel:useLongIds:ModifyIdFormat' :: ModifyIdFormat -> Bool
$sel:resource:ModifyIdFormat' :: ModifyIdFormat -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
useLongIds

instance Prelude.NFData ModifyIdFormat where
  rnf :: ModifyIdFormat -> ()
rnf ModifyIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
$sel:useLongIds:ModifyIdFormat' :: ModifyIdFormat -> Bool
$sel:resource:ModifyIdFormat' :: ModifyIdFormat -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
useLongIds

instance Data.ToHeaders ModifyIdFormat where
  toHeaders :: ModifyIdFormat -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyIdFormat where
  toQuery :: ModifyIdFormat -> QueryString
toQuery ModifyIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
$sel:useLongIds:ModifyIdFormat' :: ModifyIdFormat -> Bool
$sel:resource:ModifyIdFormat' :: ModifyIdFormat -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyIdFormat" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Resource" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
resource,
        ByteString
"UseLongIds" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
useLongIds
      ]

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

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

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