{-# 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.ModifyAddressAttribute
-- 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 an attribute of the specified Elastic 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.ModifyAddressAttribute
  ( -- * Creating a Request
    ModifyAddressAttribute (..),
    newModifyAddressAttribute,

    -- * Request Lenses
    modifyAddressAttribute_domainName,
    modifyAddressAttribute_dryRun,
    modifyAddressAttribute_allocationId,

    -- * Destructuring the Response
    ModifyAddressAttributeResponse (..),
    newModifyAddressAttributeResponse,

    -- * Response Lenses
    modifyAddressAttributeResponse_address,
    modifyAddressAttributeResponse_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:/ 'newModifyAddressAttribute' smart constructor.
data ModifyAddressAttribute = ModifyAddressAttribute'
  { -- | The domain name to modify for the IP address.
    ModifyAddressAttribute -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    ModifyAddressAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | [EC2-VPC] The allocation ID.
    ModifyAddressAttribute -> Text
allocationId :: Prelude.Text
  }
  deriving (ModifyAddressAttribute -> ModifyAddressAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyAddressAttribute -> ModifyAddressAttribute -> Bool
$c/= :: ModifyAddressAttribute -> ModifyAddressAttribute -> Bool
== :: ModifyAddressAttribute -> ModifyAddressAttribute -> Bool
$c== :: ModifyAddressAttribute -> ModifyAddressAttribute -> Bool
Prelude.Eq, ReadPrec [ModifyAddressAttribute]
ReadPrec ModifyAddressAttribute
Int -> ReadS ModifyAddressAttribute
ReadS [ModifyAddressAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyAddressAttribute]
$creadListPrec :: ReadPrec [ModifyAddressAttribute]
readPrec :: ReadPrec ModifyAddressAttribute
$creadPrec :: ReadPrec ModifyAddressAttribute
readList :: ReadS [ModifyAddressAttribute]
$creadList :: ReadS [ModifyAddressAttribute]
readsPrec :: Int -> ReadS ModifyAddressAttribute
$creadsPrec :: Int -> ReadS ModifyAddressAttribute
Prelude.Read, Int -> ModifyAddressAttribute -> ShowS
[ModifyAddressAttribute] -> ShowS
ModifyAddressAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyAddressAttribute] -> ShowS
$cshowList :: [ModifyAddressAttribute] -> ShowS
show :: ModifyAddressAttribute -> String
$cshow :: ModifyAddressAttribute -> String
showsPrec :: Int -> ModifyAddressAttribute -> ShowS
$cshowsPrec :: Int -> ModifyAddressAttribute -> ShowS
Prelude.Show, forall x. Rep ModifyAddressAttribute x -> ModifyAddressAttribute
forall x. ModifyAddressAttribute -> Rep ModifyAddressAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyAddressAttribute x -> ModifyAddressAttribute
$cfrom :: forall x. ModifyAddressAttribute -> Rep ModifyAddressAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifyAddressAttribute' 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:
--
-- 'domainName', 'modifyAddressAttribute_domainName' - The domain name to modify for the IP address.
--
-- 'dryRun', 'modifyAddressAttribute_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', 'modifyAddressAttribute_allocationId' - [EC2-VPC] The allocation ID.
newModifyAddressAttribute ::
  -- | 'allocationId'
  Prelude.Text ->
  ModifyAddressAttribute
newModifyAddressAttribute :: Text -> ModifyAddressAttribute
newModifyAddressAttribute Text
pAllocationId_ =
  ModifyAddressAttribute'
    { $sel:domainName:ModifyAddressAttribute' :: Maybe Text
domainName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyAddressAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:allocationId:ModifyAddressAttribute' :: Text
allocationId = Text
pAllocationId_
    }

-- | The domain name to modify for the IP address.
modifyAddressAttribute_domainName :: Lens.Lens' ModifyAddressAttribute (Prelude.Maybe Prelude.Text)
modifyAddressAttribute_domainName :: Lens' ModifyAddressAttribute (Maybe Text)
modifyAddressAttribute_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyAddressAttribute' {Maybe Text
domainName :: Maybe Text
$sel:domainName:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: ModifyAddressAttribute
s@ModifyAddressAttribute' {} Maybe Text
a -> ModifyAddressAttribute
s {$sel:domainName:ModifyAddressAttribute' :: Maybe Text
domainName = Maybe Text
a} :: ModifyAddressAttribute)

-- | 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@.
modifyAddressAttribute_dryRun :: Lens.Lens' ModifyAddressAttribute (Prelude.Maybe Prelude.Bool)
modifyAddressAttribute_dryRun :: Lens' ModifyAddressAttribute (Maybe Bool)
modifyAddressAttribute_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyAddressAttribute' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyAddressAttribute
s@ModifyAddressAttribute' {} Maybe Bool
a -> ModifyAddressAttribute
s {$sel:dryRun:ModifyAddressAttribute' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyAddressAttribute)

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

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

instance Prelude.NFData ModifyAddressAttribute where
  rnf :: ModifyAddressAttribute -> ()
rnf ModifyAddressAttribute' {Maybe Bool
Maybe Text
Text
allocationId :: Text
dryRun :: Maybe Bool
domainName :: Maybe Text
$sel:allocationId:ModifyAddressAttribute' :: ModifyAddressAttribute -> Text
$sel:dryRun:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Bool
$sel:domainName:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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

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

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

instance Data.ToQuery ModifyAddressAttribute where
  toQuery :: ModifyAddressAttribute -> QueryString
toQuery ModifyAddressAttribute' {Maybe Bool
Maybe Text
Text
allocationId :: Text
dryRun :: Maybe Bool
domainName :: Maybe Text
$sel:allocationId:ModifyAddressAttribute' :: ModifyAddressAttribute -> Text
$sel:dryRun:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Bool
$sel:domainName:ModifyAddressAttribute' :: ModifyAddressAttribute -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyAddressAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DomainName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
domainName,
        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
      ]

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

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

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

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

instance
  Prelude.NFData
    ModifyAddressAttributeResponse
  where
  rnf :: ModifyAddressAttributeResponse -> ()
rnf ModifyAddressAttributeResponse' {Int
Maybe AddressAttribute
httpStatus :: Int
address :: Maybe AddressAttribute
$sel:httpStatus:ModifyAddressAttributeResponse' :: ModifyAddressAttributeResponse -> Int
$sel:address:ModifyAddressAttributeResponse' :: ModifyAddressAttributeResponse -> 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