{-# 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.WorkSpacesWeb.CreateNetworkSettings
-- 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 network settings resource that can be associated with a web
-- portal. Once associated with a web portal, network settings define how
-- streaming instances will connect with your specified VPC.
module Amazonka.WorkSpacesWeb.CreateNetworkSettings
  ( -- * Creating a Request
    CreateNetworkSettings (..),
    newCreateNetworkSettings,

    -- * Request Lenses
    createNetworkSettings_clientToken,
    createNetworkSettings_tags,
    createNetworkSettings_securityGroupIds,
    createNetworkSettings_subnetIds,
    createNetworkSettings_vpcId,

    -- * Destructuring the Response
    CreateNetworkSettingsResponse (..),
    newCreateNetworkSettingsResponse,

    -- * Response Lenses
    createNetworkSettingsResponse_httpStatus,
    createNetworkSettingsResponse_networkSettingsArn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WorkSpacesWeb.Types

-- | /See:/ 'newCreateNetworkSettings' smart constructor.
data CreateNetworkSettings = CreateNetworkSettings'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Idempotency ensures that an API request
    -- completes only once. With an idempotent request, if the original request
    -- completes successfully, subsequent retries with the same client token
    -- returns the result from the original successful request.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the AWS SDK.
    CreateNetworkSettings -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The tags to add to the network settings resource. A tag is a key-value
    -- pair.
    CreateNetworkSettings -> Maybe [Sensitive Tag]
tags :: Prelude.Maybe [Data.Sensitive Tag],
    -- | One or more security groups used to control access from streaming
    -- instances to your VPC.
    CreateNetworkSettings -> NonEmpty Text
securityGroupIds :: Prelude.NonEmpty Prelude.Text,
    -- | The subnets in which network interfaces are created to connect streaming
    -- instances to your VPC. At least two of these subnets must be in
    -- different availability zones.
    CreateNetworkSettings -> NonEmpty Text
subnetIds :: Prelude.NonEmpty Prelude.Text,
    -- | The VPC that streaming instances will connect to.
    CreateNetworkSettings -> Text
vpcId :: Prelude.Text
  }
  deriving (CreateNetworkSettings -> CreateNetworkSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkSettings -> CreateNetworkSettings -> Bool
$c/= :: CreateNetworkSettings -> CreateNetworkSettings -> Bool
== :: CreateNetworkSettings -> CreateNetworkSettings -> Bool
$c== :: CreateNetworkSettings -> CreateNetworkSettings -> Bool
Prelude.Eq, Int -> CreateNetworkSettings -> ShowS
[CreateNetworkSettings] -> ShowS
CreateNetworkSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkSettings] -> ShowS
$cshowList :: [CreateNetworkSettings] -> ShowS
show :: CreateNetworkSettings -> String
$cshow :: CreateNetworkSettings -> String
showsPrec :: Int -> CreateNetworkSettings -> ShowS
$cshowsPrec :: Int -> CreateNetworkSettings -> ShowS
Prelude.Show, forall x. Rep CreateNetworkSettings x -> CreateNetworkSettings
forall x. CreateNetworkSettings -> Rep CreateNetworkSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateNetworkSettings x -> CreateNetworkSettings
$cfrom :: forall x. CreateNetworkSettings -> Rep CreateNetworkSettings x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkSettings' 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:
--
-- 'clientToken', 'createNetworkSettings_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- returns the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
--
-- 'tags', 'createNetworkSettings_tags' - The tags to add to the network settings resource. A tag is a key-value
-- pair.
--
-- 'securityGroupIds', 'createNetworkSettings_securityGroupIds' - One or more security groups used to control access from streaming
-- instances to your VPC.
--
-- 'subnetIds', 'createNetworkSettings_subnetIds' - The subnets in which network interfaces are created to connect streaming
-- instances to your VPC. At least two of these subnets must be in
-- different availability zones.
--
-- 'vpcId', 'createNetworkSettings_vpcId' - The VPC that streaming instances will connect to.
newCreateNetworkSettings ::
  -- | 'securityGroupIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'subnetIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'vpcId'
  Prelude.Text ->
  CreateNetworkSettings
newCreateNetworkSettings :: NonEmpty Text -> NonEmpty Text -> Text -> CreateNetworkSettings
newCreateNetworkSettings
  NonEmpty Text
pSecurityGroupIds_
  NonEmpty Text
pSubnetIds_
  Text
pVpcId_ =
    CreateNetworkSettings'
      { $sel:clientToken:CreateNetworkSettings' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateNetworkSettings' :: Maybe [Sensitive Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateNetworkSettings' :: NonEmpty Text
securityGroupIds =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSecurityGroupIds_,
        $sel:subnetIds:CreateNetworkSettings' :: NonEmpty Text
subnetIds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSubnetIds_,
        $sel:vpcId:CreateNetworkSettings' :: Text
vpcId = Text
pVpcId_
      }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- returns the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
createNetworkSettings_clientToken :: Lens.Lens' CreateNetworkSettings (Prelude.Maybe Prelude.Text)
createNetworkSettings_clientToken :: Lens' CreateNetworkSettings (Maybe Text)
createNetworkSettings_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettings' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateNetworkSettings
s@CreateNetworkSettings' {} Maybe Text
a -> CreateNetworkSettings
s {$sel:clientToken:CreateNetworkSettings' :: Maybe Text
clientToken = Maybe Text
a} :: CreateNetworkSettings)

-- | The tags to add to the network settings resource. A tag is a key-value
-- pair.
createNetworkSettings_tags :: Lens.Lens' CreateNetworkSettings (Prelude.Maybe [Tag])
createNetworkSettings_tags :: Lens' CreateNetworkSettings (Maybe [Tag])
createNetworkSettings_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettings' {Maybe [Sensitive Tag]
tags :: Maybe [Sensitive Tag]
$sel:tags:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe [Sensitive Tag]
tags} -> Maybe [Sensitive Tag]
tags) (\s :: CreateNetworkSettings
s@CreateNetworkSettings' {} Maybe [Sensitive Tag]
a -> CreateNetworkSettings
s {$sel:tags:CreateNetworkSettings' :: Maybe [Sensitive Tag]
tags = Maybe [Sensitive Tag]
a} :: CreateNetworkSettings) 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

-- | One or more security groups used to control access from streaming
-- instances to your VPC.
createNetworkSettings_securityGroupIds :: Lens.Lens' CreateNetworkSettings (Prelude.NonEmpty Prelude.Text)
createNetworkSettings_securityGroupIds :: Lens' CreateNetworkSettings (NonEmpty Text)
createNetworkSettings_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettings' {NonEmpty Text
securityGroupIds :: NonEmpty Text
$sel:securityGroupIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
securityGroupIds} -> NonEmpty Text
securityGroupIds) (\s :: CreateNetworkSettings
s@CreateNetworkSettings' {} NonEmpty Text
a -> CreateNetworkSettings
s {$sel:securityGroupIds:CreateNetworkSettings' :: NonEmpty Text
securityGroupIds = NonEmpty Text
a} :: CreateNetworkSettings) 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

-- | The subnets in which network interfaces are created to connect streaming
-- instances to your VPC. At least two of these subnets must be in
-- different availability zones.
createNetworkSettings_subnetIds :: Lens.Lens' CreateNetworkSettings (Prelude.NonEmpty Prelude.Text)
createNetworkSettings_subnetIds :: Lens' CreateNetworkSettings (NonEmpty Text)
createNetworkSettings_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettings' {NonEmpty Text
subnetIds :: NonEmpty Text
$sel:subnetIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
subnetIds} -> NonEmpty Text
subnetIds) (\s :: CreateNetworkSettings
s@CreateNetworkSettings' {} NonEmpty Text
a -> CreateNetworkSettings
s {$sel:subnetIds:CreateNetworkSettings' :: NonEmpty Text
subnetIds = NonEmpty Text
a} :: CreateNetworkSettings) 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

-- | The VPC that streaming instances will connect to.
createNetworkSettings_vpcId :: Lens.Lens' CreateNetworkSettings Prelude.Text
createNetworkSettings_vpcId :: Lens' CreateNetworkSettings Text
createNetworkSettings_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettings' {Text
vpcId :: Text
$sel:vpcId:CreateNetworkSettings' :: CreateNetworkSettings -> Text
vpcId} -> Text
vpcId) (\s :: CreateNetworkSettings
s@CreateNetworkSettings' {} Text
a -> CreateNetworkSettings
s {$sel:vpcId:CreateNetworkSettings' :: Text
vpcId = Text
a} :: CreateNetworkSettings)

instance Core.AWSRequest CreateNetworkSettings where
  type
    AWSResponse CreateNetworkSettings =
      CreateNetworkSettingsResponse
  request :: (Service -> Service)
-> CreateNetworkSettings -> Request CreateNetworkSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateNetworkSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateNetworkSettings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> CreateNetworkSettingsResponse
CreateNetworkSettingsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"networkSettingsArn")
      )

instance Prelude.Hashable CreateNetworkSettings where
  hashWithSalt :: Int -> CreateNetworkSettings -> Int
hashWithSalt Int
_salt CreateNetworkSettings' {Maybe [Sensitive Tag]
Maybe Text
NonEmpty Text
Text
vpcId :: Text
subnetIds :: NonEmpty Text
securityGroupIds :: NonEmpty Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:vpcId:CreateNetworkSettings' :: CreateNetworkSettings -> Text
$sel:subnetIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:securityGroupIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:tags:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Sensitive Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId

instance Prelude.NFData CreateNetworkSettings where
  rnf :: CreateNetworkSettings -> ()
rnf CreateNetworkSettings' {Maybe [Sensitive Tag]
Maybe Text
NonEmpty Text
Text
vpcId :: Text
subnetIds :: NonEmpty Text
securityGroupIds :: NonEmpty Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:vpcId:CreateNetworkSettings' :: CreateNetworkSettings -> Text
$sel:subnetIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:securityGroupIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:tags:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Sensitive Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId

instance Data.ToHeaders CreateNetworkSettings where
  toHeaders :: CreateNetworkSettings -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateNetworkSettings where
  toJSON :: CreateNetworkSettings -> Value
toJSON CreateNetworkSettings' {Maybe [Sensitive Tag]
Maybe Text
NonEmpty Text
Text
vpcId :: Text
subnetIds :: NonEmpty Text
securityGroupIds :: NonEmpty Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:vpcId:CreateNetworkSettings' :: CreateNetworkSettings -> Text
$sel:subnetIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:securityGroupIds:CreateNetworkSettings' :: CreateNetworkSettings -> NonEmpty Text
$sel:tags:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateNetworkSettings' :: CreateNetworkSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Sensitive Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"securityGroupIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
securityGroupIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"subnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
subnetIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"vpcId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
vpcId)
          ]
      )

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

instance Data.ToQuery CreateNetworkSettings where
  toQuery :: CreateNetworkSettings -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateNetworkSettingsResponse' smart constructor.
data CreateNetworkSettingsResponse = CreateNetworkSettingsResponse'
  { -- | The response's http status code.
    CreateNetworkSettingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN of the network settings.
    CreateNetworkSettingsResponse -> Text
networkSettingsArn :: Prelude.Text
  }
  deriving (CreateNetworkSettingsResponse
-> CreateNetworkSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkSettingsResponse
-> CreateNetworkSettingsResponse -> Bool
$c/= :: CreateNetworkSettingsResponse
-> CreateNetworkSettingsResponse -> Bool
== :: CreateNetworkSettingsResponse
-> CreateNetworkSettingsResponse -> Bool
$c== :: CreateNetworkSettingsResponse
-> CreateNetworkSettingsResponse -> Bool
Prelude.Eq, ReadPrec [CreateNetworkSettingsResponse]
ReadPrec CreateNetworkSettingsResponse
Int -> ReadS CreateNetworkSettingsResponse
ReadS [CreateNetworkSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkSettingsResponse]
$creadListPrec :: ReadPrec [CreateNetworkSettingsResponse]
readPrec :: ReadPrec CreateNetworkSettingsResponse
$creadPrec :: ReadPrec CreateNetworkSettingsResponse
readList :: ReadS [CreateNetworkSettingsResponse]
$creadList :: ReadS [CreateNetworkSettingsResponse]
readsPrec :: Int -> ReadS CreateNetworkSettingsResponse
$creadsPrec :: Int -> ReadS CreateNetworkSettingsResponse
Prelude.Read, Int -> CreateNetworkSettingsResponse -> ShowS
[CreateNetworkSettingsResponse] -> ShowS
CreateNetworkSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkSettingsResponse] -> ShowS
$cshowList :: [CreateNetworkSettingsResponse] -> ShowS
show :: CreateNetworkSettingsResponse -> String
$cshow :: CreateNetworkSettingsResponse -> String
showsPrec :: Int -> CreateNetworkSettingsResponse -> ShowS
$cshowsPrec :: Int -> CreateNetworkSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep CreateNetworkSettingsResponse x
-> CreateNetworkSettingsResponse
forall x.
CreateNetworkSettingsResponse
-> Rep CreateNetworkSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNetworkSettingsResponse x
-> CreateNetworkSettingsResponse
$cfrom :: forall x.
CreateNetworkSettingsResponse
-> Rep CreateNetworkSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkSettingsResponse' 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:
--
-- 'httpStatus', 'createNetworkSettingsResponse_httpStatus' - The response's http status code.
--
-- 'networkSettingsArn', 'createNetworkSettingsResponse_networkSettingsArn' - The ARN of the network settings.
newCreateNetworkSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'networkSettingsArn'
  Prelude.Text ->
  CreateNetworkSettingsResponse
newCreateNetworkSettingsResponse :: Int -> Text -> CreateNetworkSettingsResponse
newCreateNetworkSettingsResponse
  Int
pHttpStatus_
  Text
pNetworkSettingsArn_ =
    CreateNetworkSettingsResponse'
      { $sel:httpStatus:CreateNetworkSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:networkSettingsArn:CreateNetworkSettingsResponse' :: Text
networkSettingsArn = Text
pNetworkSettingsArn_
      }

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

-- | The ARN of the network settings.
createNetworkSettingsResponse_networkSettingsArn :: Lens.Lens' CreateNetworkSettingsResponse Prelude.Text
createNetworkSettingsResponse_networkSettingsArn :: Lens' CreateNetworkSettingsResponse Text
createNetworkSettingsResponse_networkSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkSettingsResponse' {Text
networkSettingsArn :: Text
$sel:networkSettingsArn:CreateNetworkSettingsResponse' :: CreateNetworkSettingsResponse -> Text
networkSettingsArn} -> Text
networkSettingsArn) (\s :: CreateNetworkSettingsResponse
s@CreateNetworkSettingsResponse' {} Text
a -> CreateNetworkSettingsResponse
s {$sel:networkSettingsArn:CreateNetworkSettingsResponse' :: Text
networkSettingsArn = Text
a} :: CreateNetworkSettingsResponse)

instance Prelude.NFData CreateNetworkSettingsResponse where
  rnf :: CreateNetworkSettingsResponse -> ()
rnf CreateNetworkSettingsResponse' {Int
Text
networkSettingsArn :: Text
httpStatus :: Int
$sel:networkSettingsArn:CreateNetworkSettingsResponse' :: CreateNetworkSettingsResponse -> Text
$sel:httpStatus:CreateNetworkSettingsResponse' :: CreateNetworkSettingsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkSettingsArn