{-# 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.ResetAddressAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets the attribute of the specified IP address. For requirements, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/elastic-ip-addresses-eip.html#Using_Elastic_Addressing_Reverse_DNS Using reverse DNS for email applications>.
module Amazonka.EC2.ResetAddressAttribute
  ( -- * Creating a Request
    ResetAddressAttribute (..),
    newResetAddressAttribute,

    -- * Request Lenses
    resetAddressAttribute_dryRun,
    resetAddressAttribute_allocationId,
    resetAddressAttribute_attribute,

    -- * Destructuring the Response
    ResetAddressAttributeResponse (..),
    newResetAddressAttributeResponse,

    -- * Response Lenses
    resetAddressAttributeResponse_address,
    resetAddressAttributeResponse_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:/ 'newResetAddressAttribute' smart constructor.
data ResetAddressAttribute = ResetAddressAttribute'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ResetAddressAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | [EC2-VPC] The allocation ID.
    ResetAddressAttribute -> Text
allocationId :: Prelude.Text,
    -- | The attribute of the IP address.
    ResetAddressAttribute -> AddressAttributeName
attribute :: AddressAttributeName
  }
  deriving (ResetAddressAttribute -> ResetAddressAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetAddressAttribute -> ResetAddressAttribute -> Bool
$c/= :: ResetAddressAttribute -> ResetAddressAttribute -> Bool
== :: ResetAddressAttribute -> ResetAddressAttribute -> Bool
$c== :: ResetAddressAttribute -> ResetAddressAttribute -> Bool
Prelude.Eq, ReadPrec [ResetAddressAttribute]
ReadPrec ResetAddressAttribute
Int -> ReadS ResetAddressAttribute
ReadS [ResetAddressAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetAddressAttribute]
$creadListPrec :: ReadPrec [ResetAddressAttribute]
readPrec :: ReadPrec ResetAddressAttribute
$creadPrec :: ReadPrec ResetAddressAttribute
readList :: ReadS [ResetAddressAttribute]
$creadList :: ReadS [ResetAddressAttribute]
readsPrec :: Int -> ReadS ResetAddressAttribute
$creadsPrec :: Int -> ReadS ResetAddressAttribute
Prelude.Read, Int -> ResetAddressAttribute -> ShowS
[ResetAddressAttribute] -> ShowS
ResetAddressAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetAddressAttribute] -> ShowS
$cshowList :: [ResetAddressAttribute] -> ShowS
show :: ResetAddressAttribute -> String
$cshow :: ResetAddressAttribute -> String
showsPrec :: Int -> ResetAddressAttribute -> ShowS
$cshowsPrec :: Int -> ResetAddressAttribute -> ShowS
Prelude.Show, forall x. Rep ResetAddressAttribute x -> ResetAddressAttribute
forall x. ResetAddressAttribute -> Rep ResetAddressAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetAddressAttribute x -> ResetAddressAttribute
$cfrom :: forall x. ResetAddressAttribute -> Rep ResetAddressAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ResetAddressAttribute' 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:
--
-- 'dryRun', 'resetAddressAttribute_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'allocationId', 'resetAddressAttribute_allocationId' - [EC2-VPC] The allocation ID.
--
-- 'attribute', 'resetAddressAttribute_attribute' - The attribute of the IP address.
newResetAddressAttribute ::
  -- | 'allocationId'
  Prelude.Text ->
  -- | 'attribute'
  AddressAttributeName ->
  ResetAddressAttribute
newResetAddressAttribute :: Text -> AddressAttributeName -> ResetAddressAttribute
newResetAddressAttribute Text
pAllocationId_ AddressAttributeName
pAttribute_ =
  ResetAddressAttribute'
    { $sel:dryRun:ResetAddressAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:allocationId:ResetAddressAttribute' :: Text
allocationId = Text
pAllocationId_,
      $sel:attribute:ResetAddressAttribute' :: AddressAttributeName
attribute = AddressAttributeName
pAttribute_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
resetAddressAttribute_dryRun :: Lens.Lens' ResetAddressAttribute (Prelude.Maybe Prelude.Bool)
resetAddressAttribute_dryRun :: Lens' ResetAddressAttribute (Maybe Bool)
resetAddressAttribute_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAddressAttribute' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ResetAddressAttribute' :: ResetAddressAttribute -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ResetAddressAttribute
s@ResetAddressAttribute' {} Maybe Bool
a -> ResetAddressAttribute
s {$sel:dryRun:ResetAddressAttribute' :: Maybe Bool
dryRun = Maybe Bool
a} :: ResetAddressAttribute)

-- | [EC2-VPC] The allocation ID.
resetAddressAttribute_allocationId :: Lens.Lens' ResetAddressAttribute Prelude.Text
resetAddressAttribute_allocationId :: Lens' ResetAddressAttribute Text
resetAddressAttribute_allocationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAddressAttribute' {Text
allocationId :: Text
$sel:allocationId:ResetAddressAttribute' :: ResetAddressAttribute -> Text
allocationId} -> Text
allocationId) (\s :: ResetAddressAttribute
s@ResetAddressAttribute' {} Text
a -> ResetAddressAttribute
s {$sel:allocationId:ResetAddressAttribute' :: Text
allocationId = Text
a} :: ResetAddressAttribute)

-- | The attribute of the IP address.
resetAddressAttribute_attribute :: Lens.Lens' ResetAddressAttribute AddressAttributeName
resetAddressAttribute_attribute :: Lens' ResetAddressAttribute AddressAttributeName
resetAddressAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAddressAttribute' {AddressAttributeName
attribute :: AddressAttributeName
$sel:attribute:ResetAddressAttribute' :: ResetAddressAttribute -> AddressAttributeName
attribute} -> AddressAttributeName
attribute) (\s :: ResetAddressAttribute
s@ResetAddressAttribute' {} AddressAttributeName
a -> ResetAddressAttribute
s {$sel:attribute:ResetAddressAttribute' :: AddressAttributeName
attribute = AddressAttributeName
a} :: ResetAddressAttribute)

instance Core.AWSRequest ResetAddressAttribute where
  type
    AWSResponse ResetAddressAttribute =
      ResetAddressAttributeResponse
  request :: (Service -> Service)
-> ResetAddressAttribute -> Request ResetAddressAttribute
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 ResetAddressAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetAddressAttribute)))
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 AddressAttribute -> Int -> ResetAddressAttributeResponse
ResetAddressAttributeResponse'
            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
"address")
            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 ResetAddressAttribute where
  hashWithSalt :: Int -> ResetAddressAttribute -> Int
hashWithSalt Int
_salt ResetAddressAttribute' {Maybe Bool
Text
AddressAttributeName
attribute :: AddressAttributeName
allocationId :: Text
dryRun :: Maybe Bool
$sel:attribute:ResetAddressAttribute' :: ResetAddressAttribute -> AddressAttributeName
$sel:allocationId:ResetAddressAttribute' :: ResetAddressAttribute -> Text
$sel:dryRun:ResetAddressAttribute' :: ResetAddressAttribute -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
allocationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AddressAttributeName
attribute

instance Prelude.NFData ResetAddressAttribute where
  rnf :: ResetAddressAttribute -> ()
rnf ResetAddressAttribute' {Maybe Bool
Text
AddressAttributeName
attribute :: AddressAttributeName
allocationId :: Text
dryRun :: Maybe Bool
$sel:attribute:ResetAddressAttribute' :: ResetAddressAttribute -> AddressAttributeName
$sel:allocationId:ResetAddressAttribute' :: ResetAddressAttribute -> Text
$sel:dryRun:ResetAddressAttribute' :: ResetAddressAttribute -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
allocationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AddressAttributeName
attribute

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

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

instance Data.ToQuery ResetAddressAttribute where
  toQuery :: ResetAddressAttribute -> QueryString
toQuery ResetAddressAttribute' {Maybe Bool
Text
AddressAttributeName
attribute :: AddressAttributeName
allocationId :: Text
dryRun :: Maybe Bool
$sel:attribute:ResetAddressAttribute' :: ResetAddressAttribute -> AddressAttributeName
$sel:allocationId:ResetAddressAttribute' :: ResetAddressAttribute -> Text
$sel:dryRun:ResetAddressAttribute' :: ResetAddressAttribute -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ResetAddressAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"AllocationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
allocationId,
        ByteString
"Attribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: AddressAttributeName
attribute
      ]

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

-- |
-- Create a value of 'ResetAddressAttributeResponse' 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:
--
-- 'address', 'resetAddressAttributeResponse_address' - Information about the IP address.
--
-- 'httpStatus', 'resetAddressAttributeResponse_httpStatus' - The response's http status code.
newResetAddressAttributeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetAddressAttributeResponse
newResetAddressAttributeResponse :: Int -> ResetAddressAttributeResponse
newResetAddressAttributeResponse Int
pHttpStatus_ =
  ResetAddressAttributeResponse'
    { $sel:address:ResetAddressAttributeResponse' :: Maybe AddressAttribute
address =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResetAddressAttributeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the IP address.
resetAddressAttributeResponse_address :: Lens.Lens' ResetAddressAttributeResponse (Prelude.Maybe AddressAttribute)
resetAddressAttributeResponse_address :: Lens' ResetAddressAttributeResponse (Maybe AddressAttribute)
resetAddressAttributeResponse_address = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAddressAttributeResponse' {Maybe AddressAttribute
address :: Maybe AddressAttribute
$sel:address:ResetAddressAttributeResponse' :: ResetAddressAttributeResponse -> Maybe AddressAttribute
address} -> Maybe AddressAttribute
address) (\s :: ResetAddressAttributeResponse
s@ResetAddressAttributeResponse' {} Maybe AddressAttribute
a -> ResetAddressAttributeResponse
s {$sel:address:ResetAddressAttributeResponse' :: Maybe AddressAttribute
address = Maybe AddressAttribute
a} :: ResetAddressAttributeResponse)

-- | The response's http status code.
resetAddressAttributeResponse_httpStatus :: Lens.Lens' ResetAddressAttributeResponse Prelude.Int
resetAddressAttributeResponse_httpStatus :: Lens' ResetAddressAttributeResponse Int
resetAddressAttributeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAddressAttributeResponse' {Int
httpStatus :: Int
$sel:httpStatus:ResetAddressAttributeResponse' :: ResetAddressAttributeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ResetAddressAttributeResponse
s@ResetAddressAttributeResponse' {} Int
a -> ResetAddressAttributeResponse
s {$sel:httpStatus:ResetAddressAttributeResponse' :: Int
httpStatus = Int
a} :: ResetAddressAttributeResponse)

instance Prelude.NFData ResetAddressAttributeResponse where
  rnf :: ResetAddressAttributeResponse -> ()
rnf ResetAddressAttributeResponse' {Int
Maybe AddressAttribute
httpStatus :: Int
address :: Maybe AddressAttribute
$sel:httpStatus:ResetAddressAttributeResponse' :: ResetAddressAttributeResponse -> Int
$sel:address:ResetAddressAttributeResponse' :: ResetAddressAttributeResponse -> Maybe AddressAttribute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AddressAttribute
address
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus