{-# 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.ReleaseAddress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Releases the specified Elastic IP address.
--
-- [EC2-Classic, default VPC] Releasing an Elastic IP address automatically
-- disassociates it from any instance that it\'s associated with. To
-- disassociate an Elastic IP address without releasing it, use
-- DisassociateAddress.
--
-- We are retiring EC2-Classic. We recommend that you migrate from
-- EC2-Classic to a VPC. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/vpc-migrate.html Migrate from EC2-Classic to a VPC>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- [Nondefault VPC] You must use DisassociateAddress to disassociate the
-- Elastic IP address before you can release it. Otherwise, Amazon EC2
-- returns an error (@InvalidIPAddress.InUse@).
--
-- After releasing an Elastic IP address, it is released to the IP address
-- pool. Be sure to update your DNS records and any servers or devices that
-- communicate with the address. If you attempt to release an Elastic IP
-- address that you already released, you\'ll get an @AuthFailure@ error if
-- the address is already allocated to another Amazon Web Services account.
--
-- [EC2-VPC] After you release an Elastic IP address for use in a VPC, you
-- might be able to recover it. For more information, see AllocateAddress.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/elastic-ip-addresses-eip.html Elastic IP Addresses>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.ReleaseAddress
  ( -- * Creating a Request
    ReleaseAddress (..),
    newReleaseAddress,

    -- * Request Lenses
    releaseAddress_allocationId,
    releaseAddress_dryRun,
    releaseAddress_networkBorderGroup,
    releaseAddress_publicIp,

    -- * Destructuring the Response
    ReleaseAddressResponse (..),
    newReleaseAddressResponse,
  )
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:/ 'newReleaseAddress' smart constructor.
data ReleaseAddress = ReleaseAddress'
  { -- | [EC2-VPC] The allocation ID. Required for EC2-VPC.
    ReleaseAddress -> Maybe Text
allocationId :: 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@.
    ReleaseAddress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The set of Availability Zones, Local Zones, or Wavelength Zones from
    -- which Amazon Web Services advertises IP addresses.
    --
    -- If you provide an incorrect network border group, you receive an
    -- @InvalidAddress.NotFound@ error.
    --
    -- You cannot use a network border group with EC2 Classic. If you attempt
    -- this operation on EC2 classic, you receive an
    -- @InvalidParameterCombination@ error.
    ReleaseAddress -> Maybe Text
networkBorderGroup :: Prelude.Maybe Prelude.Text,
    -- | [EC2-Classic] The Elastic IP address. Required for EC2-Classic.
    ReleaseAddress -> Maybe Text
publicIp :: Prelude.Maybe Prelude.Text
  }
  deriving (ReleaseAddress -> ReleaseAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseAddress -> ReleaseAddress -> Bool
$c/= :: ReleaseAddress -> ReleaseAddress -> Bool
== :: ReleaseAddress -> ReleaseAddress -> Bool
$c== :: ReleaseAddress -> ReleaseAddress -> Bool
Prelude.Eq, ReadPrec [ReleaseAddress]
ReadPrec ReleaseAddress
Int -> ReadS ReleaseAddress
ReadS [ReleaseAddress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseAddress]
$creadListPrec :: ReadPrec [ReleaseAddress]
readPrec :: ReadPrec ReleaseAddress
$creadPrec :: ReadPrec ReleaseAddress
readList :: ReadS [ReleaseAddress]
$creadList :: ReadS [ReleaseAddress]
readsPrec :: Int -> ReadS ReleaseAddress
$creadsPrec :: Int -> ReadS ReleaseAddress
Prelude.Read, Int -> ReleaseAddress -> ShowS
[ReleaseAddress] -> ShowS
ReleaseAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseAddress] -> ShowS
$cshowList :: [ReleaseAddress] -> ShowS
show :: ReleaseAddress -> String
$cshow :: ReleaseAddress -> String
showsPrec :: Int -> ReleaseAddress -> ShowS
$cshowsPrec :: Int -> ReleaseAddress -> ShowS
Prelude.Show, forall x. Rep ReleaseAddress x -> ReleaseAddress
forall x. ReleaseAddress -> Rep ReleaseAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReleaseAddress x -> ReleaseAddress
$cfrom :: forall x. ReleaseAddress -> Rep ReleaseAddress x
Prelude.Generic)

-- |
-- Create a value of 'ReleaseAddress' 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:
--
-- 'allocationId', 'releaseAddress_allocationId' - [EC2-VPC] The allocation ID. Required for EC2-VPC.
--
-- 'dryRun', 'releaseAddress_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@.
--
-- 'networkBorderGroup', 'releaseAddress_networkBorderGroup' - The set of Availability Zones, Local Zones, or Wavelength Zones from
-- which Amazon Web Services advertises IP addresses.
--
-- If you provide an incorrect network border group, you receive an
-- @InvalidAddress.NotFound@ error.
--
-- You cannot use a network border group with EC2 Classic. If you attempt
-- this operation on EC2 classic, you receive an
-- @InvalidParameterCombination@ error.
--
-- 'publicIp', 'releaseAddress_publicIp' - [EC2-Classic] The Elastic IP address. Required for EC2-Classic.
newReleaseAddress ::
  ReleaseAddress
newReleaseAddress :: ReleaseAddress
newReleaseAddress =
  ReleaseAddress'
    { $sel:allocationId:ReleaseAddress' :: Maybe Text
allocationId = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ReleaseAddress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:networkBorderGroup:ReleaseAddress' :: Maybe Text
networkBorderGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:publicIp:ReleaseAddress' :: Maybe Text
publicIp = forall a. Maybe a
Prelude.Nothing
    }

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

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

-- | The set of Availability Zones, Local Zones, or Wavelength Zones from
-- which Amazon Web Services advertises IP addresses.
--
-- If you provide an incorrect network border group, you receive an
-- @InvalidAddress.NotFound@ error.
--
-- You cannot use a network border group with EC2 Classic. If you attempt
-- this operation on EC2 classic, you receive an
-- @InvalidParameterCombination@ error.
releaseAddress_networkBorderGroup :: Lens.Lens' ReleaseAddress (Prelude.Maybe Prelude.Text)
releaseAddress_networkBorderGroup :: Lens' ReleaseAddress (Maybe Text)
releaseAddress_networkBorderGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseAddress' {Maybe Text
networkBorderGroup :: Maybe Text
$sel:networkBorderGroup:ReleaseAddress' :: ReleaseAddress -> Maybe Text
networkBorderGroup} -> Maybe Text
networkBorderGroup) (\s :: ReleaseAddress
s@ReleaseAddress' {} Maybe Text
a -> ReleaseAddress
s {$sel:networkBorderGroup:ReleaseAddress' :: Maybe Text
networkBorderGroup = Maybe Text
a} :: ReleaseAddress)

-- | [EC2-Classic] The Elastic IP address. Required for EC2-Classic.
releaseAddress_publicIp :: Lens.Lens' ReleaseAddress (Prelude.Maybe Prelude.Text)
releaseAddress_publicIp :: Lens' ReleaseAddress (Maybe Text)
releaseAddress_publicIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseAddress' {Maybe Text
publicIp :: Maybe Text
$sel:publicIp:ReleaseAddress' :: ReleaseAddress -> Maybe Text
publicIp} -> Maybe Text
publicIp) (\s :: ReleaseAddress
s@ReleaseAddress' {} Maybe Text
a -> ReleaseAddress
s {$sel:publicIp:ReleaseAddress' :: Maybe Text
publicIp = Maybe Text
a} :: ReleaseAddress)

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

instance Prelude.Hashable ReleaseAddress where
  hashWithSalt :: Int -> ReleaseAddress -> Int
hashWithSalt Int
_salt ReleaseAddress' {Maybe Bool
Maybe Text
publicIp :: Maybe Text
networkBorderGroup :: Maybe Text
dryRun :: Maybe Bool
allocationId :: Maybe Text
$sel:publicIp:ReleaseAddress' :: ReleaseAddress -> Maybe Text
$sel:networkBorderGroup:ReleaseAddress' :: ReleaseAddress -> Maybe Text
$sel:dryRun:ReleaseAddress' :: ReleaseAddress -> Maybe Bool
$sel:allocationId:ReleaseAddress' :: ReleaseAddress -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
allocationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkBorderGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publicIp

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

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

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

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

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

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

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