{-# 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.AssociateDhcpOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a set of DHCP options (that you\'ve previously created) with
-- the specified VPC, or associates no DHCP options with the VPC.
--
-- After you associate the options with the VPC, any existing instances and
-- all new instances that you launch in that VPC use the options. You
-- don\'t need to restart or relaunch the instances. They automatically
-- pick up the changes within a few hours, depending on how frequently the
-- instance renews its DHCP lease. You can explicitly renew the lease using
-- the operating system on the instance.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_DHCP_Options.html DHCP options sets>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.AssociateDhcpOptions
  ( -- * Creating a Request
    AssociateDhcpOptions (..),
    newAssociateDhcpOptions,

    -- * Request Lenses
    associateDhcpOptions_dryRun,
    associateDhcpOptions_dhcpOptionsId,
    associateDhcpOptions_vpcId,

    -- * Destructuring the Response
    AssociateDhcpOptionsResponse (..),
    newAssociateDhcpOptionsResponse,
  )
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:/ 'newAssociateDhcpOptions' smart constructor.
data AssociateDhcpOptions = AssociateDhcpOptions'
  { -- | 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@.
    AssociateDhcpOptions -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the DHCP options set, or @default@ to associate no DHCP
    -- options with the VPC.
    AssociateDhcpOptions -> Text
dhcpOptionsId :: Prelude.Text,
    -- | The ID of the VPC.
    AssociateDhcpOptions -> Text
vpcId :: Prelude.Text
  }
  deriving (AssociateDhcpOptions -> AssociateDhcpOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateDhcpOptions -> AssociateDhcpOptions -> Bool
$c/= :: AssociateDhcpOptions -> AssociateDhcpOptions -> Bool
== :: AssociateDhcpOptions -> AssociateDhcpOptions -> Bool
$c== :: AssociateDhcpOptions -> AssociateDhcpOptions -> Bool
Prelude.Eq, ReadPrec [AssociateDhcpOptions]
ReadPrec AssociateDhcpOptions
Int -> ReadS AssociateDhcpOptions
ReadS [AssociateDhcpOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateDhcpOptions]
$creadListPrec :: ReadPrec [AssociateDhcpOptions]
readPrec :: ReadPrec AssociateDhcpOptions
$creadPrec :: ReadPrec AssociateDhcpOptions
readList :: ReadS [AssociateDhcpOptions]
$creadList :: ReadS [AssociateDhcpOptions]
readsPrec :: Int -> ReadS AssociateDhcpOptions
$creadsPrec :: Int -> ReadS AssociateDhcpOptions
Prelude.Read, Int -> AssociateDhcpOptions -> ShowS
[AssociateDhcpOptions] -> ShowS
AssociateDhcpOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateDhcpOptions] -> ShowS
$cshowList :: [AssociateDhcpOptions] -> ShowS
show :: AssociateDhcpOptions -> String
$cshow :: AssociateDhcpOptions -> String
showsPrec :: Int -> AssociateDhcpOptions -> ShowS
$cshowsPrec :: Int -> AssociateDhcpOptions -> ShowS
Prelude.Show, forall x. Rep AssociateDhcpOptions x -> AssociateDhcpOptions
forall x. AssociateDhcpOptions -> Rep AssociateDhcpOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateDhcpOptions x -> AssociateDhcpOptions
$cfrom :: forall x. AssociateDhcpOptions -> Rep AssociateDhcpOptions x
Prelude.Generic)

-- |
-- Create a value of 'AssociateDhcpOptions' 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', 'associateDhcpOptions_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@.
--
-- 'dhcpOptionsId', 'associateDhcpOptions_dhcpOptionsId' - The ID of the DHCP options set, or @default@ to associate no DHCP
-- options with the VPC.
--
-- 'vpcId', 'associateDhcpOptions_vpcId' - The ID of the VPC.
newAssociateDhcpOptions ::
  -- | 'dhcpOptionsId'
  Prelude.Text ->
  -- | 'vpcId'
  Prelude.Text ->
  AssociateDhcpOptions
newAssociateDhcpOptions :: Text -> Text -> AssociateDhcpOptions
newAssociateDhcpOptions Text
pDhcpOptionsId_ Text
pVpcId_ =
  AssociateDhcpOptions'
    { $sel:dryRun:AssociateDhcpOptions' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:dhcpOptionsId:AssociateDhcpOptions' :: Text
dhcpOptionsId = Text
pDhcpOptionsId_,
      $sel:vpcId:AssociateDhcpOptions' :: Text
vpcId = Text
pVpcId_
    }

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

-- | The ID of the DHCP options set, or @default@ to associate no DHCP
-- options with the VPC.
associateDhcpOptions_dhcpOptionsId :: Lens.Lens' AssociateDhcpOptions Prelude.Text
associateDhcpOptions_dhcpOptionsId :: Lens' AssociateDhcpOptions Text
associateDhcpOptions_dhcpOptionsId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDhcpOptions' {Text
dhcpOptionsId :: Text
$sel:dhcpOptionsId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
dhcpOptionsId} -> Text
dhcpOptionsId) (\s :: AssociateDhcpOptions
s@AssociateDhcpOptions' {} Text
a -> AssociateDhcpOptions
s {$sel:dhcpOptionsId:AssociateDhcpOptions' :: Text
dhcpOptionsId = Text
a} :: AssociateDhcpOptions)

-- | The ID of the VPC.
associateDhcpOptions_vpcId :: Lens.Lens' AssociateDhcpOptions Prelude.Text
associateDhcpOptions_vpcId :: Lens' AssociateDhcpOptions Text
associateDhcpOptions_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDhcpOptions' {Text
vpcId :: Text
$sel:vpcId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
vpcId} -> Text
vpcId) (\s :: AssociateDhcpOptions
s@AssociateDhcpOptions' {} Text
a -> AssociateDhcpOptions
s {$sel:vpcId:AssociateDhcpOptions' :: Text
vpcId = Text
a} :: AssociateDhcpOptions)

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

instance Prelude.Hashable AssociateDhcpOptions where
  hashWithSalt :: Int -> AssociateDhcpOptions -> Int
hashWithSalt Int
_salt AssociateDhcpOptions' {Maybe Bool
Text
vpcId :: Text
dhcpOptionsId :: Text
dryRun :: Maybe Bool
$sel:vpcId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
$sel:dhcpOptionsId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
$sel:dryRun:AssociateDhcpOptions' :: AssociateDhcpOptions -> 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
dhcpOptionsId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId

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

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

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

instance Data.ToQuery AssociateDhcpOptions where
  toQuery :: AssociateDhcpOptions -> QueryString
toQuery AssociateDhcpOptions' {Maybe Bool
Text
vpcId :: Text
dhcpOptionsId :: Text
dryRun :: Maybe Bool
$sel:vpcId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
$sel:dhcpOptionsId:AssociateDhcpOptions' :: AssociateDhcpOptions -> Text
$sel:dryRun:AssociateDhcpOptions' :: AssociateDhcpOptions -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AssociateDhcpOptions" :: 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
"DhcpOptionsId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dhcpOptionsId,
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpcId
      ]

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

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

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