{-# 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.DescribeIdFormat
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the ID format settings for your resources on a per-Region
-- basis, for example, to view which resource types are enabled for longer
-- IDs. This request only returns information about resource types whose ID
-- formats can be modified; it does not return information about other
-- resource types.
--
-- The following resource types support longer IDs: @bundle@ |
-- @conversion-task@ | @customer-gateway@ | @dhcp-options@ |
-- @elastic-ip-allocation@ | @elastic-ip-association@ | @export-task@ |
-- @flow-log@ | @image@ | @import-task@ | @instance@ | @internet-gateway@ |
-- @network-acl@ | @network-acl-association@ | @network-interface@ |
-- @network-interface-attachment@ | @prefix-list@ | @reservation@ |
-- @route-table@ | @route-table-association@ | @security-group@ |
-- @snapshot@ | @subnet@ | @subnet-cidr-block-association@ | @volume@ |
-- @vpc@ | @vpc-cidr-block-association@ | @vpc-endpoint@ |
-- @vpc-peering-connection@ | @vpn-connection@ | @vpn-gateway@.
--
-- These settings apply to the IAM user who makes the request; they do not
-- apply to the entire Amazon Web Services account. By default, an IAM user
-- defaults to the same settings as the root user, unless they explicitly
-- override the settings by running the ModifyIdFormat command. Resources
-- created with longer IDs are visible to all IAM users, regardless of
-- these settings and provided that they have permission to use the
-- relevant @Describe@ command for the resource type.
module Amazonka.EC2.DescribeIdFormat
  ( -- * Creating a Request
    DescribeIdFormat (..),
    newDescribeIdFormat,

    -- * Request Lenses
    describeIdFormat_resource,

    -- * Destructuring the Response
    DescribeIdFormatResponse (..),
    newDescribeIdFormatResponse,

    -- * Response Lenses
    describeIdFormatResponse_statuses,
    describeIdFormatResponse_httpStatus,
  )
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:/ 'newDescribeIdFormat' smart constructor.
data DescribeIdFormat = DescribeIdFormat'
  { -- | The type of resource: @bundle@ | @conversion-task@ | @customer-gateway@
    -- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
    -- @export-task@ | @flow-log@ | @image@ | @import-task@ | @instance@ |
    -- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
    -- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
    -- @reservation@ | @route-table@ | @route-table-association@ |
    -- @security-group@ | @snapshot@ | @subnet@ |
    -- @subnet-cidr-block-association@ | @volume@ | @vpc@ |
    -- @vpc-cidr-block-association@ | @vpc-endpoint@ | @vpc-peering-connection@
    -- | @vpn-connection@ | @vpn-gateway@
    DescribeIdFormat -> Maybe Text
resource :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeIdFormat -> DescribeIdFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeIdFormat -> DescribeIdFormat -> Bool
$c/= :: DescribeIdFormat -> DescribeIdFormat -> Bool
== :: DescribeIdFormat -> DescribeIdFormat -> Bool
$c== :: DescribeIdFormat -> DescribeIdFormat -> Bool
Prelude.Eq, ReadPrec [DescribeIdFormat]
ReadPrec DescribeIdFormat
Int -> ReadS DescribeIdFormat
ReadS [DescribeIdFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeIdFormat]
$creadListPrec :: ReadPrec [DescribeIdFormat]
readPrec :: ReadPrec DescribeIdFormat
$creadPrec :: ReadPrec DescribeIdFormat
readList :: ReadS [DescribeIdFormat]
$creadList :: ReadS [DescribeIdFormat]
readsPrec :: Int -> ReadS DescribeIdFormat
$creadsPrec :: Int -> ReadS DescribeIdFormat
Prelude.Read, Int -> DescribeIdFormat -> ShowS
[DescribeIdFormat] -> ShowS
DescribeIdFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeIdFormat] -> ShowS
$cshowList :: [DescribeIdFormat] -> ShowS
show :: DescribeIdFormat -> String
$cshow :: DescribeIdFormat -> String
showsPrec :: Int -> DescribeIdFormat -> ShowS
$cshowsPrec :: Int -> DescribeIdFormat -> ShowS
Prelude.Show, forall x. Rep DescribeIdFormat x -> DescribeIdFormat
forall x. DescribeIdFormat -> Rep DescribeIdFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeIdFormat x -> DescribeIdFormat
$cfrom :: forall x. DescribeIdFormat -> Rep DescribeIdFormat x
Prelude.Generic)

-- |
-- Create a value of 'DescribeIdFormat' 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', 'describeIdFormat_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@ | @instance@ |
-- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
-- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
-- @reservation@ | @route-table@ | @route-table-association@ |
-- @security-group@ | @snapshot@ | @subnet@ |
-- @subnet-cidr-block-association@ | @volume@ | @vpc@ |
-- @vpc-cidr-block-association@ | @vpc-endpoint@ | @vpc-peering-connection@
-- | @vpn-connection@ | @vpn-gateway@
newDescribeIdFormat ::
  DescribeIdFormat
newDescribeIdFormat :: DescribeIdFormat
newDescribeIdFormat =
  DescribeIdFormat' {$sel:resource:DescribeIdFormat' :: Maybe Text
resource = forall a. Maybe a
Prelude.Nothing}

-- | The type of resource: @bundle@ | @conversion-task@ | @customer-gateway@
-- | @dhcp-options@ | @elastic-ip-allocation@ | @elastic-ip-association@ |
-- @export-task@ | @flow-log@ | @image@ | @import-task@ | @instance@ |
-- @internet-gateway@ | @network-acl@ | @network-acl-association@ |
-- @network-interface@ | @network-interface-attachment@ | @prefix-list@ |
-- @reservation@ | @route-table@ | @route-table-association@ |
-- @security-group@ | @snapshot@ | @subnet@ |
-- @subnet-cidr-block-association@ | @volume@ | @vpc@ |
-- @vpc-cidr-block-association@ | @vpc-endpoint@ | @vpc-peering-connection@
-- | @vpn-connection@ | @vpn-gateway@
describeIdFormat_resource :: Lens.Lens' DescribeIdFormat (Prelude.Maybe Prelude.Text)
describeIdFormat_resource :: Lens' DescribeIdFormat (Maybe Text)
describeIdFormat_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeIdFormat' {Maybe Text
resource :: Maybe Text
$sel:resource:DescribeIdFormat' :: DescribeIdFormat -> Maybe Text
resource} -> Maybe Text
resource) (\s :: DescribeIdFormat
s@DescribeIdFormat' {} Maybe Text
a -> DescribeIdFormat
s {$sel:resource:DescribeIdFormat' :: Maybe Text
resource = Maybe Text
a} :: DescribeIdFormat)

instance Core.AWSRequest DescribeIdFormat where
  type
    AWSResponse DescribeIdFormat =
      DescribeIdFormatResponse
  request :: (Service -> Service)
-> DescribeIdFormat -> Request DescribeIdFormat
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 DescribeIdFormat
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeIdFormat)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [IdFormat] -> Int -> DescribeIdFormatResponse
DescribeIdFormatResponse'
            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
"statusSet"
                            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")
                        )
            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 DescribeIdFormat where
  hashWithSalt :: Int -> DescribeIdFormat -> Int
hashWithSalt Int
_salt DescribeIdFormat' {Maybe Text
resource :: Maybe Text
$sel:resource:DescribeIdFormat' :: DescribeIdFormat -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resource

instance Prelude.NFData DescribeIdFormat where
  rnf :: DescribeIdFormat -> ()
rnf DescribeIdFormat' {Maybe Text
resource :: Maybe Text
$sel:resource:DescribeIdFormat' :: DescribeIdFormat -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resource

instance Data.ToHeaders DescribeIdFormat where
  toHeaders :: DescribeIdFormat -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeIdFormat where
  toQuery :: DescribeIdFormat -> QueryString
toQuery DescribeIdFormat' {Maybe Text
resource :: Maybe Text
$sel:resource:DescribeIdFormat' :: DescribeIdFormat -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeIdFormat" :: 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.=: Maybe Text
resource
      ]

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

-- |
-- Create a value of 'DescribeIdFormatResponse' 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:
--
-- 'statuses', 'describeIdFormatResponse_statuses' - Information about the ID format for the resource.
--
-- 'httpStatus', 'describeIdFormatResponse_httpStatus' - The response's http status code.
newDescribeIdFormatResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeIdFormatResponse
newDescribeIdFormatResponse :: Int -> DescribeIdFormatResponse
newDescribeIdFormatResponse Int
pHttpStatus_ =
  DescribeIdFormatResponse'
    { $sel:statuses:DescribeIdFormatResponse' :: Maybe [IdFormat]
statuses =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeIdFormatResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the ID format for the resource.
describeIdFormatResponse_statuses :: Lens.Lens' DescribeIdFormatResponse (Prelude.Maybe [IdFormat])
describeIdFormatResponse_statuses :: Lens' DescribeIdFormatResponse (Maybe [IdFormat])
describeIdFormatResponse_statuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeIdFormatResponse' {Maybe [IdFormat]
statuses :: Maybe [IdFormat]
$sel:statuses:DescribeIdFormatResponse' :: DescribeIdFormatResponse -> Maybe [IdFormat]
statuses} -> Maybe [IdFormat]
statuses) (\s :: DescribeIdFormatResponse
s@DescribeIdFormatResponse' {} Maybe [IdFormat]
a -> DescribeIdFormatResponse
s {$sel:statuses:DescribeIdFormatResponse' :: Maybe [IdFormat]
statuses = Maybe [IdFormat]
a} :: DescribeIdFormatResponse) 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.
describeIdFormatResponse_httpStatus :: Lens.Lens' DescribeIdFormatResponse Prelude.Int
describeIdFormatResponse_httpStatus :: Lens' DescribeIdFormatResponse Int
describeIdFormatResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeIdFormatResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeIdFormatResponse' :: DescribeIdFormatResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeIdFormatResponse
s@DescribeIdFormatResponse' {} Int
a -> DescribeIdFormatResponse
s {$sel:httpStatus:DescribeIdFormatResponse' :: Int
httpStatus = Int
a} :: DescribeIdFormatResponse)

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