{-# 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.DisassociateAddress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates an Elastic IP address from the instance or network
-- interface it\'s associated with.
--
-- An Elastic IP address is for use in either the EC2-Classic platform or
-- in a VPC. 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/.
--
-- 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/.
--
-- This is an idempotent operation. If you perform the operation more than
-- once, Amazon EC2 doesn\'t return an error.
module Amazonka.EC2.DisassociateAddress
  ( -- * Creating a Request
    DisassociateAddress (..),
    newDisassociateAddress,

    -- * Request Lenses
    disassociateAddress_associationId,
    disassociateAddress_dryRun,
    disassociateAddress_publicIp,

    -- * Destructuring the Response
    DisassociateAddressResponse (..),
    newDisassociateAddressResponse,
  )
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:/ 'newDisassociateAddress' smart constructor.
data DisassociateAddress = DisassociateAddress'
  { -- | [EC2-VPC] The association ID. Required for EC2-VPC.
    DisassociateAddress -> Maybe Text
associationId :: 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@.
    DisassociateAddress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | [EC2-Classic] The Elastic IP address. Required for EC2-Classic.
    DisassociateAddress -> Maybe Text
publicIp :: Prelude.Maybe Prelude.Text
  }
  deriving (DisassociateAddress -> DisassociateAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateAddress -> DisassociateAddress -> Bool
$c/= :: DisassociateAddress -> DisassociateAddress -> Bool
== :: DisassociateAddress -> DisassociateAddress -> Bool
$c== :: DisassociateAddress -> DisassociateAddress -> Bool
Prelude.Eq, ReadPrec [DisassociateAddress]
ReadPrec DisassociateAddress
Int -> ReadS DisassociateAddress
ReadS [DisassociateAddress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateAddress]
$creadListPrec :: ReadPrec [DisassociateAddress]
readPrec :: ReadPrec DisassociateAddress
$creadPrec :: ReadPrec DisassociateAddress
readList :: ReadS [DisassociateAddress]
$creadList :: ReadS [DisassociateAddress]
readsPrec :: Int -> ReadS DisassociateAddress
$creadsPrec :: Int -> ReadS DisassociateAddress
Prelude.Read, Int -> DisassociateAddress -> ShowS
[DisassociateAddress] -> ShowS
DisassociateAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateAddress] -> ShowS
$cshowList :: [DisassociateAddress] -> ShowS
show :: DisassociateAddress -> String
$cshow :: DisassociateAddress -> String
showsPrec :: Int -> DisassociateAddress -> ShowS
$cshowsPrec :: Int -> DisassociateAddress -> ShowS
Prelude.Show, forall x. Rep DisassociateAddress x -> DisassociateAddress
forall x. DisassociateAddress -> Rep DisassociateAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateAddress x -> DisassociateAddress
$cfrom :: forall x. DisassociateAddress -> Rep DisassociateAddress x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateAddress' 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:
--
-- 'associationId', 'disassociateAddress_associationId' - [EC2-VPC] The association ID. Required for EC2-VPC.
--
-- 'dryRun', 'disassociateAddress_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@.
--
-- 'publicIp', 'disassociateAddress_publicIp' - [EC2-Classic] The Elastic IP address. Required for EC2-Classic.
newDisassociateAddress ::
  DisassociateAddress
newDisassociateAddress :: DisassociateAddress
newDisassociateAddress =
  DisassociateAddress'
    { $sel:associationId:DisassociateAddress' :: Maybe Text
associationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:DisassociateAddress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:publicIp:DisassociateAddress' :: Maybe Text
publicIp = forall a. Maybe a
Prelude.Nothing
    }

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

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

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

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

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

instance Prelude.NFData DisassociateAddress where
  rnf :: DisassociateAddress -> ()
rnf DisassociateAddress' {Maybe Bool
Maybe Text
publicIp :: Maybe Text
dryRun :: Maybe Bool
associationId :: Maybe Text
$sel:publicIp:DisassociateAddress' :: DisassociateAddress -> Maybe Text
$sel:dryRun:DisassociateAddress' :: DisassociateAddress -> Maybe Bool
$sel:associationId:DisassociateAddress' :: DisassociateAddress -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
associationId
      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
publicIp

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

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

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

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

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

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