{-# 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.S3Outposts.CreateEndpoint
-- 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 an endpoint and associates it with the specified Outpost.
--
-- It can take up to 5 minutes for this action to finish.
--
-- Related actions include:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_s3outposts_DeleteEndpoint.html DeleteEndpoint>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_s3outposts_ListEndpoints.html ListEndpoints>
module Amazonka.S3Outposts.CreateEndpoint
  ( -- * Creating a Request
    CreateEndpoint (..),
    newCreateEndpoint,

    -- * Request Lenses
    createEndpoint_accessType,
    createEndpoint_customerOwnedIpv4Pool,
    createEndpoint_outpostId,
    createEndpoint_subnetId,
    createEndpoint_securityGroupId,

    -- * Destructuring the Response
    CreateEndpointResponse (..),
    newCreateEndpointResponse,

    -- * Response Lenses
    createEndpointResponse_endpointArn,
    createEndpointResponse_httpStatus,
  )
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.S3Outposts.Types

-- | /See:/ 'newCreateEndpoint' smart constructor.
data CreateEndpoint = CreateEndpoint'
  { -- | The type of access for the network connectivity for the Amazon S3 on
    -- Outposts endpoint. To use the Amazon Web Services VPC, choose @Private@.
    -- To use the endpoint with an on-premises network, choose
    -- @CustomerOwnedIp@. If you choose @CustomerOwnedIp@, you must also
    -- provide the customer-owned IP address pool (CoIP pool).
    --
    -- @Private@ is the default access type value.
    CreateEndpoint -> Maybe EndpointAccessType
accessType :: Prelude.Maybe EndpointAccessType,
    -- | The ID of the customer-owned IPv4 address pool (CoIP pool) for the
    -- endpoint. IP addresses are allocated from this pool for the endpoint.
    CreateEndpoint -> Maybe Text
customerOwnedIpv4Pool :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Outposts.
    CreateEndpoint -> Text
outpostId :: Prelude.Text,
    -- | The ID of the subnet in the selected VPC. The endpoint subnet must
    -- belong to the Outpost that has Amazon S3 on Outposts provisioned.
    CreateEndpoint -> Text
subnetId :: Prelude.Text,
    -- | The ID of the security group to use with the endpoint.
    CreateEndpoint -> Text
securityGroupId :: Prelude.Text
  }
  deriving (CreateEndpoint -> CreateEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpoint -> CreateEndpoint -> Bool
$c/= :: CreateEndpoint -> CreateEndpoint -> Bool
== :: CreateEndpoint -> CreateEndpoint -> Bool
$c== :: CreateEndpoint -> CreateEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateEndpoint]
ReadPrec CreateEndpoint
Int -> ReadS CreateEndpoint
ReadS [CreateEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpoint]
$creadListPrec :: ReadPrec [CreateEndpoint]
readPrec :: ReadPrec CreateEndpoint
$creadPrec :: ReadPrec CreateEndpoint
readList :: ReadS [CreateEndpoint]
$creadList :: ReadS [CreateEndpoint]
readsPrec :: Int -> ReadS CreateEndpoint
$creadsPrec :: Int -> ReadS CreateEndpoint
Prelude.Read, Int -> CreateEndpoint -> ShowS
[CreateEndpoint] -> ShowS
CreateEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpoint] -> ShowS
$cshowList :: [CreateEndpoint] -> ShowS
show :: CreateEndpoint -> String
$cshow :: CreateEndpoint -> String
showsPrec :: Int -> CreateEndpoint -> ShowS
$cshowsPrec :: Int -> CreateEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateEndpoint x -> CreateEndpoint
forall x. CreateEndpoint -> Rep CreateEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEndpoint x -> CreateEndpoint
$cfrom :: forall x. CreateEndpoint -> Rep CreateEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpoint' 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:
--
-- 'accessType', 'createEndpoint_accessType' - The type of access for the network connectivity for the Amazon S3 on
-- Outposts endpoint. To use the Amazon Web Services VPC, choose @Private@.
-- To use the endpoint with an on-premises network, choose
-- @CustomerOwnedIp@. If you choose @CustomerOwnedIp@, you must also
-- provide the customer-owned IP address pool (CoIP pool).
--
-- @Private@ is the default access type value.
--
-- 'customerOwnedIpv4Pool', 'createEndpoint_customerOwnedIpv4Pool' - The ID of the customer-owned IPv4 address pool (CoIP pool) for the
-- endpoint. IP addresses are allocated from this pool for the endpoint.
--
-- 'outpostId', 'createEndpoint_outpostId' - The ID of the Outposts.
--
-- 'subnetId', 'createEndpoint_subnetId' - The ID of the subnet in the selected VPC. The endpoint subnet must
-- belong to the Outpost that has Amazon S3 on Outposts provisioned.
--
-- 'securityGroupId', 'createEndpoint_securityGroupId' - The ID of the security group to use with the endpoint.
newCreateEndpoint ::
  -- | 'outpostId'
  Prelude.Text ->
  -- | 'subnetId'
  Prelude.Text ->
  -- | 'securityGroupId'
  Prelude.Text ->
  CreateEndpoint
newCreateEndpoint :: Text -> Text -> Text -> CreateEndpoint
newCreateEndpoint
  Text
pOutpostId_
  Text
pSubnetId_
  Text
pSecurityGroupId_ =
    CreateEndpoint'
      { $sel:accessType:CreateEndpoint' :: Maybe EndpointAccessType
accessType = forall a. Maybe a
Prelude.Nothing,
        $sel:customerOwnedIpv4Pool:CreateEndpoint' :: Maybe Text
customerOwnedIpv4Pool = forall a. Maybe a
Prelude.Nothing,
        $sel:outpostId:CreateEndpoint' :: Text
outpostId = Text
pOutpostId_,
        $sel:subnetId:CreateEndpoint' :: Text
subnetId = Text
pSubnetId_,
        $sel:securityGroupId:CreateEndpoint' :: Text
securityGroupId = Text
pSecurityGroupId_
      }

-- | The type of access for the network connectivity for the Amazon S3 on
-- Outposts endpoint. To use the Amazon Web Services VPC, choose @Private@.
-- To use the endpoint with an on-premises network, choose
-- @CustomerOwnedIp@. If you choose @CustomerOwnedIp@, you must also
-- provide the customer-owned IP address pool (CoIP pool).
--
-- @Private@ is the default access type value.
createEndpoint_accessType :: Lens.Lens' CreateEndpoint (Prelude.Maybe EndpointAccessType)
createEndpoint_accessType :: Lens' CreateEndpoint (Maybe EndpointAccessType)
createEndpoint_accessType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Maybe EndpointAccessType
accessType :: Maybe EndpointAccessType
$sel:accessType:CreateEndpoint' :: CreateEndpoint -> Maybe EndpointAccessType
accessType} -> Maybe EndpointAccessType
accessType) (\s :: CreateEndpoint
s@CreateEndpoint' {} Maybe EndpointAccessType
a -> CreateEndpoint
s {$sel:accessType:CreateEndpoint' :: Maybe EndpointAccessType
accessType = Maybe EndpointAccessType
a} :: CreateEndpoint)

-- | The ID of the customer-owned IPv4 address pool (CoIP pool) for the
-- endpoint. IP addresses are allocated from this pool for the endpoint.
createEndpoint_customerOwnedIpv4Pool :: Lens.Lens' CreateEndpoint (Prelude.Maybe Prelude.Text)
createEndpoint_customerOwnedIpv4Pool :: Lens' CreateEndpoint (Maybe Text)
createEndpoint_customerOwnedIpv4Pool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Maybe Text
customerOwnedIpv4Pool :: Maybe Text
$sel:customerOwnedIpv4Pool:CreateEndpoint' :: CreateEndpoint -> Maybe Text
customerOwnedIpv4Pool} -> Maybe Text
customerOwnedIpv4Pool) (\s :: CreateEndpoint
s@CreateEndpoint' {} Maybe Text
a -> CreateEndpoint
s {$sel:customerOwnedIpv4Pool:CreateEndpoint' :: Maybe Text
customerOwnedIpv4Pool = Maybe Text
a} :: CreateEndpoint)

-- | The ID of the Outposts.
createEndpoint_outpostId :: Lens.Lens' CreateEndpoint Prelude.Text
createEndpoint_outpostId :: Lens' CreateEndpoint Text
createEndpoint_outpostId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Text
outpostId :: Text
$sel:outpostId:CreateEndpoint' :: CreateEndpoint -> Text
outpostId} -> Text
outpostId) (\s :: CreateEndpoint
s@CreateEndpoint' {} Text
a -> CreateEndpoint
s {$sel:outpostId:CreateEndpoint' :: Text
outpostId = Text
a} :: CreateEndpoint)

-- | The ID of the subnet in the selected VPC. The endpoint subnet must
-- belong to the Outpost that has Amazon S3 on Outposts provisioned.
createEndpoint_subnetId :: Lens.Lens' CreateEndpoint Prelude.Text
createEndpoint_subnetId :: Lens' CreateEndpoint Text
createEndpoint_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Text
subnetId :: Text
$sel:subnetId:CreateEndpoint' :: CreateEndpoint -> Text
subnetId} -> Text
subnetId) (\s :: CreateEndpoint
s@CreateEndpoint' {} Text
a -> CreateEndpoint
s {$sel:subnetId:CreateEndpoint' :: Text
subnetId = Text
a} :: CreateEndpoint)

-- | The ID of the security group to use with the endpoint.
createEndpoint_securityGroupId :: Lens.Lens' CreateEndpoint Prelude.Text
createEndpoint_securityGroupId :: Lens' CreateEndpoint Text
createEndpoint_securityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Text
securityGroupId :: Text
$sel:securityGroupId:CreateEndpoint' :: CreateEndpoint -> Text
securityGroupId} -> Text
securityGroupId) (\s :: CreateEndpoint
s@CreateEndpoint' {} Text
a -> CreateEndpoint
s {$sel:securityGroupId:CreateEndpoint' :: Text
securityGroupId = Text
a} :: CreateEndpoint)

instance Core.AWSRequest CreateEndpoint where
  type
    AWSResponse CreateEndpoint =
      CreateEndpointResponse
  request :: (Service -> Service) -> CreateEndpoint -> Request CreateEndpoint
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 CreateEndpoint
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateEndpoint)))
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 ->
          Maybe Text -> Int -> CreateEndpointResponse
CreateEndpointResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndpointArn")
            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 CreateEndpoint where
  hashWithSalt :: Int -> CreateEndpoint -> Int
hashWithSalt Int
_salt CreateEndpoint' {Maybe Text
Maybe EndpointAccessType
Text
securityGroupId :: Text
subnetId :: Text
outpostId :: Text
customerOwnedIpv4Pool :: Maybe Text
accessType :: Maybe EndpointAccessType
$sel:securityGroupId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:subnetId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:outpostId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:customerOwnedIpv4Pool:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:accessType:CreateEndpoint' :: CreateEndpoint -> Maybe EndpointAccessType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointAccessType
accessType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customerOwnedIpv4Pool
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outpostId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subnetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
securityGroupId

instance Prelude.NFData CreateEndpoint where
  rnf :: CreateEndpoint -> ()
rnf CreateEndpoint' {Maybe Text
Maybe EndpointAccessType
Text
securityGroupId :: Text
subnetId :: Text
outpostId :: Text
customerOwnedIpv4Pool :: Maybe Text
accessType :: Maybe EndpointAccessType
$sel:securityGroupId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:subnetId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:outpostId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:customerOwnedIpv4Pool:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:accessType:CreateEndpoint' :: CreateEndpoint -> Maybe EndpointAccessType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointAccessType
accessType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customerOwnedIpv4Pool
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
outpostId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
subnetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
securityGroupId

instance Data.ToHeaders CreateEndpoint where
  toHeaders :: CreateEndpoint -> 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 CreateEndpoint where
  toJSON :: CreateEndpoint -> Value
toJSON CreateEndpoint' {Maybe Text
Maybe EndpointAccessType
Text
securityGroupId :: Text
subnetId :: Text
outpostId :: Text
customerOwnedIpv4Pool :: Maybe Text
accessType :: Maybe EndpointAccessType
$sel:securityGroupId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:subnetId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:outpostId:CreateEndpoint' :: CreateEndpoint -> Text
$sel:customerOwnedIpv4Pool:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:accessType:CreateEndpoint' :: CreateEndpoint -> Maybe EndpointAccessType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessType" 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 EndpointAccessType
accessType,
            (Key
"CustomerOwnedIpv4Pool" 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
customerOwnedIpv4Pool,
            forall a. a -> Maybe a
Prelude.Just (Key
"OutpostId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
outpostId),
            forall a. a -> Maybe a
Prelude.Just (Key
"SubnetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subnetId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SecurityGroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
securityGroupId)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateEndpointResponse' 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:
--
-- 'endpointArn', 'createEndpointResponse_endpointArn' - The Amazon Resource Name (ARN) of the endpoint.
--
-- 'httpStatus', 'createEndpointResponse_httpStatus' - The response's http status code.
newCreateEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEndpointResponse
newCreateEndpointResponse :: Int -> CreateEndpointResponse
newCreateEndpointResponse Int
pHttpStatus_ =
  CreateEndpointResponse'
    { $sel:endpointArn:CreateEndpointResponse' :: Maybe Text
endpointArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the endpoint.
createEndpointResponse_endpointArn :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe Prelude.Text)
createEndpointResponse_endpointArn :: Lens' CreateEndpointResponse (Maybe Text)
createEndpointResponse_endpointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe Text
endpointArn :: Maybe Text
$sel:endpointArn:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
endpointArn} -> Maybe Text
endpointArn) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe Text
a -> CreateEndpointResponse
s {$sel:endpointArn:CreateEndpointResponse' :: Maybe Text
endpointArn = Maybe Text
a} :: CreateEndpointResponse)

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

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