{-# 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.CreateDhcpOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a set of DHCP options for your VPC. After creating the set, you
-- must associate it with the VPC, causing all existing and new instances
-- that you launch in the VPC to use this set of DHCP options. The
-- following are the individual DHCP options you can specify. For more
-- information about the options, see
-- <http://www.ietf.org/rfc/rfc2132.txt RFC 2132>.
--
-- -   @domain-name-servers@ - The IP addresses of up to four domain name
--     servers, or AmazonProvidedDNS. The default DHCP option set specifies
--     AmazonProvidedDNS. If specifying more than one domain name server,
--     specify the IP addresses in a single parameter, separated by commas.
--     To have your instance receive a custom DNS hostname as specified in
--     @domain-name@, you must set @domain-name-servers@ to a custom DNS
--     server.
--
-- -   @domain-name@ - If you\'re using AmazonProvidedDNS in @us-east-1@,
--     specify @ec2.internal@. If you\'re using AmazonProvidedDNS in
--     another Region, specify @region.compute.internal@ (for example,
--     @ap-northeast-1.compute.internal@). Otherwise, specify a domain name
--     (for example, @ExampleCompany.com@). This value is used to complete
--     unqualified DNS hostnames. __Important__: Some Linux operating
--     systems accept multiple domain names separated by spaces. However,
--     Windows and other Linux operating systems treat the value as a
--     single domain, which results in unexpected behavior. If your DHCP
--     options set is associated with a VPC that has instances with
--     multiple operating systems, specify only one domain name.
--
-- -   @ntp-servers@ - The IP addresses of up to four Network Time Protocol
--     (NTP) servers.
--
-- -   @netbios-name-servers@ - The IP addresses of up to four NetBIOS name
--     servers.
--
-- -   @netbios-node-type@ - The NetBIOS node type (1, 2, 4, or 8). We
--     recommend that you specify 2 (broadcast and multicast are not
--     currently supported). For more information about these node types,
--     see <http://www.ietf.org/rfc/rfc2132.txt RFC 2132>.
--
-- Your VPC automatically starts out with a set of DHCP options that
-- includes only a DNS server that we provide (AmazonProvidedDNS). If you
-- create a set of options, and if your VPC has an internet gateway, make
-- sure to set the @domain-name-servers@ option either to
-- @AmazonProvidedDNS@ or to a domain name server of your choice. 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.CreateDhcpOptions
  ( -- * Creating a Request
    CreateDhcpOptions (..),
    newCreateDhcpOptions,

    -- * Request Lenses
    createDhcpOptions_dryRun,
    createDhcpOptions_tagSpecifications,
    createDhcpOptions_dhcpConfigurations,

    -- * Destructuring the Response
    CreateDhcpOptionsResponse (..),
    newCreateDhcpOptionsResponse,

    -- * Response Lenses
    createDhcpOptionsResponse_dhcpOptions,
    createDhcpOptionsResponse_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:/ 'newCreateDhcpOptions' smart constructor.
data CreateDhcpOptions = CreateDhcpOptions'
  { -- | 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@.
    CreateDhcpOptions -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags to assign to the DHCP option.
    CreateDhcpOptions -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | A DHCP configuration option.
    CreateDhcpOptions -> [NewDhcpConfiguration]
dhcpConfigurations :: [NewDhcpConfiguration]
  }
  deriving (CreateDhcpOptions -> CreateDhcpOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDhcpOptions -> CreateDhcpOptions -> Bool
$c/= :: CreateDhcpOptions -> CreateDhcpOptions -> Bool
== :: CreateDhcpOptions -> CreateDhcpOptions -> Bool
$c== :: CreateDhcpOptions -> CreateDhcpOptions -> Bool
Prelude.Eq, ReadPrec [CreateDhcpOptions]
ReadPrec CreateDhcpOptions
Int -> ReadS CreateDhcpOptions
ReadS [CreateDhcpOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDhcpOptions]
$creadListPrec :: ReadPrec [CreateDhcpOptions]
readPrec :: ReadPrec CreateDhcpOptions
$creadPrec :: ReadPrec CreateDhcpOptions
readList :: ReadS [CreateDhcpOptions]
$creadList :: ReadS [CreateDhcpOptions]
readsPrec :: Int -> ReadS CreateDhcpOptions
$creadsPrec :: Int -> ReadS CreateDhcpOptions
Prelude.Read, Int -> CreateDhcpOptions -> ShowS
[CreateDhcpOptions] -> ShowS
CreateDhcpOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDhcpOptions] -> ShowS
$cshowList :: [CreateDhcpOptions] -> ShowS
show :: CreateDhcpOptions -> String
$cshow :: CreateDhcpOptions -> String
showsPrec :: Int -> CreateDhcpOptions -> ShowS
$cshowsPrec :: Int -> CreateDhcpOptions -> ShowS
Prelude.Show, forall x. Rep CreateDhcpOptions x -> CreateDhcpOptions
forall x. CreateDhcpOptions -> Rep CreateDhcpOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDhcpOptions x -> CreateDhcpOptions
$cfrom :: forall x. CreateDhcpOptions -> Rep CreateDhcpOptions x
Prelude.Generic)

-- |
-- Create a value of 'CreateDhcpOptions' 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', 'createDhcpOptions_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@.
--
-- 'tagSpecifications', 'createDhcpOptions_tagSpecifications' - The tags to assign to the DHCP option.
--
-- 'dhcpConfigurations', 'createDhcpOptions_dhcpConfigurations' - A DHCP configuration option.
newCreateDhcpOptions ::
  CreateDhcpOptions
newCreateDhcpOptions :: CreateDhcpOptions
newCreateDhcpOptions =
  CreateDhcpOptions'
    { $sel:dryRun:CreateDhcpOptions' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateDhcpOptions' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:dhcpConfigurations:CreateDhcpOptions' :: [NewDhcpConfiguration]
dhcpConfigurations = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | The tags to assign to the DHCP option.
createDhcpOptions_tagSpecifications :: Lens.Lens' CreateDhcpOptions (Prelude.Maybe [TagSpecification])
createDhcpOptions_tagSpecifications :: Lens' CreateDhcpOptions (Maybe [TagSpecification])
createDhcpOptions_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDhcpOptions' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateDhcpOptions' :: CreateDhcpOptions -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateDhcpOptions
s@CreateDhcpOptions' {} Maybe [TagSpecification]
a -> CreateDhcpOptions
s {$sel:tagSpecifications:CreateDhcpOptions' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateDhcpOptions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A DHCP configuration option.
createDhcpOptions_dhcpConfigurations :: Lens.Lens' CreateDhcpOptions [NewDhcpConfiguration]
createDhcpOptions_dhcpConfigurations :: Lens' CreateDhcpOptions [NewDhcpConfiguration]
createDhcpOptions_dhcpConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDhcpOptions' {[NewDhcpConfiguration]
dhcpConfigurations :: [NewDhcpConfiguration]
$sel:dhcpConfigurations:CreateDhcpOptions' :: CreateDhcpOptions -> [NewDhcpConfiguration]
dhcpConfigurations} -> [NewDhcpConfiguration]
dhcpConfigurations) (\s :: CreateDhcpOptions
s@CreateDhcpOptions' {} [NewDhcpConfiguration]
a -> CreateDhcpOptions
s {$sel:dhcpConfigurations:CreateDhcpOptions' :: [NewDhcpConfiguration]
dhcpConfigurations = [NewDhcpConfiguration]
a} :: CreateDhcpOptions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateDhcpOptions where
  type
    AWSResponse CreateDhcpOptions =
      CreateDhcpOptionsResponse
  request :: (Service -> Service)
-> CreateDhcpOptions -> Request CreateDhcpOptions
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 CreateDhcpOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDhcpOptions)))
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 DhcpOptions -> Int -> CreateDhcpOptionsResponse
CreateDhcpOptionsResponse'
            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
"dhcpOptions")
            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 CreateDhcpOptions where
  hashWithSalt :: Int -> CreateDhcpOptions -> Int
hashWithSalt Int
_salt CreateDhcpOptions' {[NewDhcpConfiguration]
Maybe Bool
Maybe [TagSpecification]
dhcpConfigurations :: [NewDhcpConfiguration]
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:dhcpConfigurations:CreateDhcpOptions' :: CreateDhcpOptions -> [NewDhcpConfiguration]
$sel:tagSpecifications:CreateDhcpOptions' :: CreateDhcpOptions -> Maybe [TagSpecification]
$sel:dryRun:CreateDhcpOptions' :: CreateDhcpOptions -> 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` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [NewDhcpConfiguration]
dhcpConfigurations

instance Prelude.NFData CreateDhcpOptions where
  rnf :: CreateDhcpOptions -> ()
rnf CreateDhcpOptions' {[NewDhcpConfiguration]
Maybe Bool
Maybe [TagSpecification]
dhcpConfigurations :: [NewDhcpConfiguration]
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:dhcpConfigurations:CreateDhcpOptions' :: CreateDhcpOptions -> [NewDhcpConfiguration]
$sel:tagSpecifications:CreateDhcpOptions' :: CreateDhcpOptions -> Maybe [TagSpecification]
$sel:dryRun:CreateDhcpOptions' :: CreateDhcpOptions -> 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 Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [NewDhcpConfiguration]
dhcpConfigurations

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

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

instance Data.ToQuery CreateDhcpOptions where
  toQuery :: CreateDhcpOptions -> QueryString
toQuery CreateDhcpOptions' {[NewDhcpConfiguration]
Maybe Bool
Maybe [TagSpecification]
dhcpConfigurations :: [NewDhcpConfiguration]
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:dhcpConfigurations:CreateDhcpOptions' :: CreateDhcpOptions -> [NewDhcpConfiguration]
$sel:tagSpecifications:CreateDhcpOptions' :: CreateDhcpOptions -> Maybe [TagSpecification]
$sel:dryRun:CreateDhcpOptions' :: CreateDhcpOptions -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateDhcpOptions" :: 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,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList
          ByteString
"DhcpConfiguration"
          [NewDhcpConfiguration]
dhcpConfigurations
      ]

-- | /See:/ 'newCreateDhcpOptionsResponse' smart constructor.
data CreateDhcpOptionsResponse = CreateDhcpOptionsResponse'
  { -- | A set of DHCP options.
    CreateDhcpOptionsResponse -> Maybe DhcpOptions
dhcpOptions :: Prelude.Maybe DhcpOptions,
    -- | The response's http status code.
    CreateDhcpOptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDhcpOptionsResponse -> CreateDhcpOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDhcpOptionsResponse -> CreateDhcpOptionsResponse -> Bool
$c/= :: CreateDhcpOptionsResponse -> CreateDhcpOptionsResponse -> Bool
== :: CreateDhcpOptionsResponse -> CreateDhcpOptionsResponse -> Bool
$c== :: CreateDhcpOptionsResponse -> CreateDhcpOptionsResponse -> Bool
Prelude.Eq, ReadPrec [CreateDhcpOptionsResponse]
ReadPrec CreateDhcpOptionsResponse
Int -> ReadS CreateDhcpOptionsResponse
ReadS [CreateDhcpOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDhcpOptionsResponse]
$creadListPrec :: ReadPrec [CreateDhcpOptionsResponse]
readPrec :: ReadPrec CreateDhcpOptionsResponse
$creadPrec :: ReadPrec CreateDhcpOptionsResponse
readList :: ReadS [CreateDhcpOptionsResponse]
$creadList :: ReadS [CreateDhcpOptionsResponse]
readsPrec :: Int -> ReadS CreateDhcpOptionsResponse
$creadsPrec :: Int -> ReadS CreateDhcpOptionsResponse
Prelude.Read, Int -> CreateDhcpOptionsResponse -> ShowS
[CreateDhcpOptionsResponse] -> ShowS
CreateDhcpOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDhcpOptionsResponse] -> ShowS
$cshowList :: [CreateDhcpOptionsResponse] -> ShowS
show :: CreateDhcpOptionsResponse -> String
$cshow :: CreateDhcpOptionsResponse -> String
showsPrec :: Int -> CreateDhcpOptionsResponse -> ShowS
$cshowsPrec :: Int -> CreateDhcpOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDhcpOptionsResponse x -> CreateDhcpOptionsResponse
forall x.
CreateDhcpOptionsResponse -> Rep CreateDhcpOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDhcpOptionsResponse x -> CreateDhcpOptionsResponse
$cfrom :: forall x.
CreateDhcpOptionsResponse -> Rep CreateDhcpOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDhcpOptionsResponse' 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:
--
-- 'dhcpOptions', 'createDhcpOptionsResponse_dhcpOptions' - A set of DHCP options.
--
-- 'httpStatus', 'createDhcpOptionsResponse_httpStatus' - The response's http status code.
newCreateDhcpOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDhcpOptionsResponse
newCreateDhcpOptionsResponse :: Int -> CreateDhcpOptionsResponse
newCreateDhcpOptionsResponse Int
pHttpStatus_ =
  CreateDhcpOptionsResponse'
    { $sel:dhcpOptions:CreateDhcpOptionsResponse' :: Maybe DhcpOptions
dhcpOptions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDhcpOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A set of DHCP options.
createDhcpOptionsResponse_dhcpOptions :: Lens.Lens' CreateDhcpOptionsResponse (Prelude.Maybe DhcpOptions)
createDhcpOptionsResponse_dhcpOptions :: Lens' CreateDhcpOptionsResponse (Maybe DhcpOptions)
createDhcpOptionsResponse_dhcpOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDhcpOptionsResponse' {Maybe DhcpOptions
dhcpOptions :: Maybe DhcpOptions
$sel:dhcpOptions:CreateDhcpOptionsResponse' :: CreateDhcpOptionsResponse -> Maybe DhcpOptions
dhcpOptions} -> Maybe DhcpOptions
dhcpOptions) (\s :: CreateDhcpOptionsResponse
s@CreateDhcpOptionsResponse' {} Maybe DhcpOptions
a -> CreateDhcpOptionsResponse
s {$sel:dhcpOptions:CreateDhcpOptionsResponse' :: Maybe DhcpOptions
dhcpOptions = Maybe DhcpOptions
a} :: CreateDhcpOptionsResponse)

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

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