{-# 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.ModifyIdentityIdFormat
-- 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 of a resource for a specified IAM user, IAM role,
-- or the root user for an account; or all IAM users, IAM roles, and the
-- root user for an account. 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@.
--
-- 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/.
--
-- This setting applies to the principal specified in the request; it does
-- not apply to the principal that makes the request.
--
-- 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.ModifyIdentityIdFormat
  ( -- * Creating a Request
    ModifyIdentityIdFormat (..),
    newModifyIdentityIdFormat,

    -- * Request Lenses
    modifyIdentityIdFormat_principalArn,
    modifyIdentityIdFormat_resource,
    modifyIdentityIdFormat_useLongIds,

    -- * Destructuring the Response
    ModifyIdentityIdFormatResponse (..),
    newModifyIdentityIdFormatResponse,
  )
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:/ 'newModifyIdentityIdFormat' smart constructor.
data ModifyIdentityIdFormat = ModifyIdentityIdFormat'
  { -- | The ARN of the principal, which can be an IAM user, IAM role, or the
    -- root user. Specify @all@ to modify the ID format for all IAM users, IAM
    -- roles, and the root user of the account.
    ModifyIdentityIdFormat -> Text
principalArn :: Prelude.Text,
    -- | 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.
    ModifyIdentityIdFormat -> Text
resource :: Prelude.Text,
    -- | Indicates whether the resource should use longer IDs (17-character IDs)
    ModifyIdentityIdFormat -> Bool
useLongIds :: Prelude.Bool
  }
  deriving (ModifyIdentityIdFormat -> ModifyIdentityIdFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyIdentityIdFormat -> ModifyIdentityIdFormat -> Bool
$c/= :: ModifyIdentityIdFormat -> ModifyIdentityIdFormat -> Bool
== :: ModifyIdentityIdFormat -> ModifyIdentityIdFormat -> Bool
$c== :: ModifyIdentityIdFormat -> ModifyIdentityIdFormat -> Bool
Prelude.Eq, ReadPrec [ModifyIdentityIdFormat]
ReadPrec ModifyIdentityIdFormat
Int -> ReadS ModifyIdentityIdFormat
ReadS [ModifyIdentityIdFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyIdentityIdFormat]
$creadListPrec :: ReadPrec [ModifyIdentityIdFormat]
readPrec :: ReadPrec ModifyIdentityIdFormat
$creadPrec :: ReadPrec ModifyIdentityIdFormat
readList :: ReadS [ModifyIdentityIdFormat]
$creadList :: ReadS [ModifyIdentityIdFormat]
readsPrec :: Int -> ReadS ModifyIdentityIdFormat
$creadsPrec :: Int -> ReadS ModifyIdentityIdFormat
Prelude.Read, Int -> ModifyIdentityIdFormat -> ShowS
[ModifyIdentityIdFormat] -> ShowS
ModifyIdentityIdFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyIdentityIdFormat] -> ShowS
$cshowList :: [ModifyIdentityIdFormat] -> ShowS
show :: ModifyIdentityIdFormat -> String
$cshow :: ModifyIdentityIdFormat -> String
showsPrec :: Int -> ModifyIdentityIdFormat -> ShowS
$cshowsPrec :: Int -> ModifyIdentityIdFormat -> ShowS
Prelude.Show, forall x. Rep ModifyIdentityIdFormat x -> ModifyIdentityIdFormat
forall x. ModifyIdentityIdFormat -> Rep ModifyIdentityIdFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyIdentityIdFormat x -> ModifyIdentityIdFormat
$cfrom :: forall x. ModifyIdentityIdFormat -> Rep ModifyIdentityIdFormat x
Prelude.Generic)

-- |
-- Create a value of 'ModifyIdentityIdFormat' 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:
--
-- 'principalArn', 'modifyIdentityIdFormat_principalArn' - The ARN of the principal, which can be an IAM user, IAM role, or the
-- root user. Specify @all@ to modify the ID format for all IAM users, IAM
-- roles, and the root user of the account.
--
-- 'resource', 'modifyIdentityIdFormat_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', 'modifyIdentityIdFormat_useLongIds' - Indicates whether the resource should use longer IDs (17-character IDs)
newModifyIdentityIdFormat ::
  -- | 'principalArn'
  Prelude.Text ->
  -- | 'resource'
  Prelude.Text ->
  -- | 'useLongIds'
  Prelude.Bool ->
  ModifyIdentityIdFormat
newModifyIdentityIdFormat :: Text -> Text -> Bool -> ModifyIdentityIdFormat
newModifyIdentityIdFormat
  Text
pPrincipalArn_
  Text
pResource_
  Bool
pUseLongIds_ =
    ModifyIdentityIdFormat'
      { $sel:principalArn:ModifyIdentityIdFormat' :: Text
principalArn =
          Text
pPrincipalArn_,
        $sel:resource:ModifyIdentityIdFormat' :: Text
resource = Text
pResource_,
        $sel:useLongIds:ModifyIdentityIdFormat' :: Bool
useLongIds = Bool
pUseLongIds_
      }

-- | The ARN of the principal, which can be an IAM user, IAM role, or the
-- root user. Specify @all@ to modify the ID format for all IAM users, IAM
-- roles, and the root user of the account.
modifyIdentityIdFormat_principalArn :: Lens.Lens' ModifyIdentityIdFormat Prelude.Text
modifyIdentityIdFormat_principalArn :: Lens' ModifyIdentityIdFormat Text
modifyIdentityIdFormat_principalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyIdentityIdFormat' {Text
principalArn :: Text
$sel:principalArn:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
principalArn} -> Text
principalArn) (\s :: ModifyIdentityIdFormat
s@ModifyIdentityIdFormat' {} Text
a -> ModifyIdentityIdFormat
s {$sel:principalArn:ModifyIdentityIdFormat' :: Text
principalArn = Text
a} :: ModifyIdentityIdFormat)

-- | 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.
modifyIdentityIdFormat_resource :: Lens.Lens' ModifyIdentityIdFormat Prelude.Text
modifyIdentityIdFormat_resource :: Lens' ModifyIdentityIdFormat Text
modifyIdentityIdFormat_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyIdentityIdFormat' {Text
resource :: Text
$sel:resource:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
resource} -> Text
resource) (\s :: ModifyIdentityIdFormat
s@ModifyIdentityIdFormat' {} Text
a -> ModifyIdentityIdFormat
s {$sel:resource:ModifyIdentityIdFormat' :: Text
resource = Text
a} :: ModifyIdentityIdFormat)

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

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

instance Prelude.Hashable ModifyIdentityIdFormat where
  hashWithSalt :: Int -> ModifyIdentityIdFormat -> Int
hashWithSalt Int
_salt ModifyIdentityIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
principalArn :: Text
$sel:useLongIds:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Bool
$sel:resource:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
$sel:principalArn:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principalArn
      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 ModifyIdentityIdFormat where
  rnf :: ModifyIdentityIdFormat -> ()
rnf ModifyIdentityIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
principalArn :: Text
$sel:useLongIds:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Bool
$sel:resource:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
$sel:principalArn:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
principalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ModifyIdentityIdFormat where
  toHeaders :: ModifyIdentityIdFormat -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyIdentityIdFormat where
  toQuery :: ModifyIdentityIdFormat -> QueryString
toQuery ModifyIdentityIdFormat' {Bool
Text
useLongIds :: Bool
resource :: Text
principalArn :: Text
$sel:useLongIds:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Bool
$sel:resource:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
$sel:principalArn:ModifyIdentityIdFormat' :: ModifyIdentityIdFormat -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyIdentityIdFormat" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"PrincipalArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
principalArn,
        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:/ 'newModifyIdentityIdFormatResponse' smart constructor.
data ModifyIdentityIdFormatResponse = ModifyIdentityIdFormatResponse'
  {
  }
  deriving (ModifyIdentityIdFormatResponse
-> ModifyIdentityIdFormatResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyIdentityIdFormatResponse
-> ModifyIdentityIdFormatResponse -> Bool
$c/= :: ModifyIdentityIdFormatResponse
-> ModifyIdentityIdFormatResponse -> Bool
== :: ModifyIdentityIdFormatResponse
-> ModifyIdentityIdFormatResponse -> Bool
$c== :: ModifyIdentityIdFormatResponse
-> ModifyIdentityIdFormatResponse -> Bool
Prelude.Eq, ReadPrec [ModifyIdentityIdFormatResponse]
ReadPrec ModifyIdentityIdFormatResponse
Int -> ReadS ModifyIdentityIdFormatResponse
ReadS [ModifyIdentityIdFormatResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyIdentityIdFormatResponse]
$creadListPrec :: ReadPrec [ModifyIdentityIdFormatResponse]
readPrec :: ReadPrec ModifyIdentityIdFormatResponse
$creadPrec :: ReadPrec ModifyIdentityIdFormatResponse
readList :: ReadS [ModifyIdentityIdFormatResponse]
$creadList :: ReadS [ModifyIdentityIdFormatResponse]
readsPrec :: Int -> ReadS ModifyIdentityIdFormatResponse
$creadsPrec :: Int -> ReadS ModifyIdentityIdFormatResponse
Prelude.Read, Int -> ModifyIdentityIdFormatResponse -> ShowS
[ModifyIdentityIdFormatResponse] -> ShowS
ModifyIdentityIdFormatResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyIdentityIdFormatResponse] -> ShowS
$cshowList :: [ModifyIdentityIdFormatResponse] -> ShowS
show :: ModifyIdentityIdFormatResponse -> String
$cshow :: ModifyIdentityIdFormatResponse -> String
showsPrec :: Int -> ModifyIdentityIdFormatResponse -> ShowS
$cshowsPrec :: Int -> ModifyIdentityIdFormatResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyIdentityIdFormatResponse x
-> ModifyIdentityIdFormatResponse
forall x.
ModifyIdentityIdFormatResponse
-> Rep ModifyIdentityIdFormatResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyIdentityIdFormatResponse x
-> ModifyIdentityIdFormatResponse
$cfrom :: forall x.
ModifyIdentityIdFormatResponse
-> Rep ModifyIdentityIdFormatResponse x
Prelude.Generic)

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

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