{-# 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.NetworkManager.CreateConnectAttachment
-- 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 core network Connect attachment from a specified core network
-- attachment.
--
-- A core network Connect attachment is a GRE-based tunnel attachment that
-- you can use to establish a connection between a core network and an
-- appliance. A core network Connect attachment uses an existing VPC
-- attachment as the underlying transport mechanism.
module Amazonka.NetworkManager.CreateConnectAttachment
  ( -- * Creating a Request
    CreateConnectAttachment (..),
    newCreateConnectAttachment,

    -- * Request Lenses
    createConnectAttachment_clientToken,
    createConnectAttachment_tags,
    createConnectAttachment_coreNetworkId,
    createConnectAttachment_edgeLocation,
    createConnectAttachment_transportAttachmentId,
    createConnectAttachment_options,

    -- * Destructuring the Response
    CreateConnectAttachmentResponse (..),
    newCreateConnectAttachmentResponse,

    -- * Response Lenses
    createConnectAttachmentResponse_connectAttachment,
    createConnectAttachmentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateConnectAttachment' smart constructor.
data CreateConnectAttachment = CreateConnectAttachment'
  { -- | The client token associated with the request.
    CreateConnectAttachment -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The list of key-value tags associated with the request.
    CreateConnectAttachment -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The ID of a core network where you want to create the attachment.
    CreateConnectAttachment -> Text
coreNetworkId :: Prelude.Text,
    -- | The Region where the edge is located.
    CreateConnectAttachment -> Text
edgeLocation :: Prelude.Text,
    -- | The ID of the attachment between the two connections.
    CreateConnectAttachment -> Text
transportAttachmentId :: Prelude.Text,
    -- | Options for creating an attachment.
    CreateConnectAttachment -> ConnectAttachmentOptions
options :: ConnectAttachmentOptions
  }
  deriving (CreateConnectAttachment -> CreateConnectAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnectAttachment -> CreateConnectAttachment -> Bool
$c/= :: CreateConnectAttachment -> CreateConnectAttachment -> Bool
== :: CreateConnectAttachment -> CreateConnectAttachment -> Bool
$c== :: CreateConnectAttachment -> CreateConnectAttachment -> Bool
Prelude.Eq, ReadPrec [CreateConnectAttachment]
ReadPrec CreateConnectAttachment
Int -> ReadS CreateConnectAttachment
ReadS [CreateConnectAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnectAttachment]
$creadListPrec :: ReadPrec [CreateConnectAttachment]
readPrec :: ReadPrec CreateConnectAttachment
$creadPrec :: ReadPrec CreateConnectAttachment
readList :: ReadS [CreateConnectAttachment]
$creadList :: ReadS [CreateConnectAttachment]
readsPrec :: Int -> ReadS CreateConnectAttachment
$creadsPrec :: Int -> ReadS CreateConnectAttachment
Prelude.Read, Int -> CreateConnectAttachment -> ShowS
[CreateConnectAttachment] -> ShowS
CreateConnectAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnectAttachment] -> ShowS
$cshowList :: [CreateConnectAttachment] -> ShowS
show :: CreateConnectAttachment -> String
$cshow :: CreateConnectAttachment -> String
showsPrec :: Int -> CreateConnectAttachment -> ShowS
$cshowsPrec :: Int -> CreateConnectAttachment -> ShowS
Prelude.Show, forall x. Rep CreateConnectAttachment x -> CreateConnectAttachment
forall x. CreateConnectAttachment -> Rep CreateConnectAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnectAttachment x -> CreateConnectAttachment
$cfrom :: forall x. CreateConnectAttachment -> Rep CreateConnectAttachment x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnectAttachment' 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', 'createConnectAttachment_clientToken' - The client token associated with the request.
--
-- 'tags', 'createConnectAttachment_tags' - The list of key-value tags associated with the request.
--
-- 'coreNetworkId', 'createConnectAttachment_coreNetworkId' - The ID of a core network where you want to create the attachment.
--
-- 'edgeLocation', 'createConnectAttachment_edgeLocation' - The Region where the edge is located.
--
-- 'transportAttachmentId', 'createConnectAttachment_transportAttachmentId' - The ID of the attachment between the two connections.
--
-- 'options', 'createConnectAttachment_options' - Options for creating an attachment.
newCreateConnectAttachment ::
  -- | 'coreNetworkId'
  Prelude.Text ->
  -- | 'edgeLocation'
  Prelude.Text ->
  -- | 'transportAttachmentId'
  Prelude.Text ->
  -- | 'options'
  ConnectAttachmentOptions ->
  CreateConnectAttachment
newCreateConnectAttachment :: Text
-> Text
-> Text
-> ConnectAttachmentOptions
-> CreateConnectAttachment
newCreateConnectAttachment
  Text
pCoreNetworkId_
  Text
pEdgeLocation_
  Text
pTransportAttachmentId_
  ConnectAttachmentOptions
pOptions_ =
    CreateConnectAttachment'
      { $sel:clientToken:CreateConnectAttachment' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateConnectAttachment' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:coreNetworkId:CreateConnectAttachment' :: Text
coreNetworkId = Text
pCoreNetworkId_,
        $sel:edgeLocation:CreateConnectAttachment' :: Text
edgeLocation = Text
pEdgeLocation_,
        $sel:transportAttachmentId:CreateConnectAttachment' :: Text
transportAttachmentId = Text
pTransportAttachmentId_,
        $sel:options:CreateConnectAttachment' :: ConnectAttachmentOptions
options = ConnectAttachmentOptions
pOptions_
      }

-- | The client token associated with the request.
createConnectAttachment_clientToken :: Lens.Lens' CreateConnectAttachment (Prelude.Maybe Prelude.Text)
createConnectAttachment_clientToken :: Lens' CreateConnectAttachment (Maybe Text)
createConnectAttachment_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateConnectAttachment' :: CreateConnectAttachment -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} Maybe Text
a -> CreateConnectAttachment
s {$sel:clientToken:CreateConnectAttachment' :: Maybe Text
clientToken = Maybe Text
a} :: CreateConnectAttachment)

-- | The list of key-value tags associated with the request.
createConnectAttachment_tags :: Lens.Lens' CreateConnectAttachment (Prelude.Maybe [Tag])
createConnectAttachment_tags :: Lens' CreateConnectAttachment (Maybe [Tag])
createConnectAttachment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateConnectAttachment' :: CreateConnectAttachment -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} Maybe [Tag]
a -> CreateConnectAttachment
s {$sel:tags:CreateConnectAttachment' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateConnectAttachment) 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

-- | The ID of a core network where you want to create the attachment.
createConnectAttachment_coreNetworkId :: Lens.Lens' CreateConnectAttachment Prelude.Text
createConnectAttachment_coreNetworkId :: Lens' CreateConnectAttachment Text
createConnectAttachment_coreNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {Text
coreNetworkId :: Text
$sel:coreNetworkId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
coreNetworkId} -> Text
coreNetworkId) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} Text
a -> CreateConnectAttachment
s {$sel:coreNetworkId:CreateConnectAttachment' :: Text
coreNetworkId = Text
a} :: CreateConnectAttachment)

-- | The Region where the edge is located.
createConnectAttachment_edgeLocation :: Lens.Lens' CreateConnectAttachment Prelude.Text
createConnectAttachment_edgeLocation :: Lens' CreateConnectAttachment Text
createConnectAttachment_edgeLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {Text
edgeLocation :: Text
$sel:edgeLocation:CreateConnectAttachment' :: CreateConnectAttachment -> Text
edgeLocation} -> Text
edgeLocation) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} Text
a -> CreateConnectAttachment
s {$sel:edgeLocation:CreateConnectAttachment' :: Text
edgeLocation = Text
a} :: CreateConnectAttachment)

-- | The ID of the attachment between the two connections.
createConnectAttachment_transportAttachmentId :: Lens.Lens' CreateConnectAttachment Prelude.Text
createConnectAttachment_transportAttachmentId :: Lens' CreateConnectAttachment Text
createConnectAttachment_transportAttachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {Text
transportAttachmentId :: Text
$sel:transportAttachmentId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
transportAttachmentId} -> Text
transportAttachmentId) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} Text
a -> CreateConnectAttachment
s {$sel:transportAttachmentId:CreateConnectAttachment' :: Text
transportAttachmentId = Text
a} :: CreateConnectAttachment)

-- | Options for creating an attachment.
createConnectAttachment_options :: Lens.Lens' CreateConnectAttachment ConnectAttachmentOptions
createConnectAttachment_options :: Lens' CreateConnectAttachment ConnectAttachmentOptions
createConnectAttachment_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachment' {ConnectAttachmentOptions
options :: ConnectAttachmentOptions
$sel:options:CreateConnectAttachment' :: CreateConnectAttachment -> ConnectAttachmentOptions
options} -> ConnectAttachmentOptions
options) (\s :: CreateConnectAttachment
s@CreateConnectAttachment' {} ConnectAttachmentOptions
a -> CreateConnectAttachment
s {$sel:options:CreateConnectAttachment' :: ConnectAttachmentOptions
options = ConnectAttachmentOptions
a} :: CreateConnectAttachment)

instance Core.AWSRequest CreateConnectAttachment where
  type
    AWSResponse CreateConnectAttachment =
      CreateConnectAttachmentResponse
  request :: (Service -> Service)
-> CreateConnectAttachment -> Request CreateConnectAttachment
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 CreateConnectAttachment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateConnectAttachment)))
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 ConnectAttachment -> Int -> CreateConnectAttachmentResponse
CreateConnectAttachmentResponse'
            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
"ConnectAttachment")
            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 CreateConnectAttachment where
  hashWithSalt :: Int -> CreateConnectAttachment -> Int
hashWithSalt Int
_salt CreateConnectAttachment' {Maybe [Tag]
Maybe Text
Text
ConnectAttachmentOptions
options :: ConnectAttachmentOptions
transportAttachmentId :: Text
edgeLocation :: Text
coreNetworkId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:options:CreateConnectAttachment' :: CreateConnectAttachment -> ConnectAttachmentOptions
$sel:transportAttachmentId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:edgeLocation:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:coreNetworkId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:tags:CreateConnectAttachment' :: CreateConnectAttachment -> Maybe [Tag]
$sel:clientToken:CreateConnectAttachment' :: CreateConnectAttachment -> 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 [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
coreNetworkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
edgeLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transportAttachmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectAttachmentOptions
options

instance Prelude.NFData CreateConnectAttachment where
  rnf :: CreateConnectAttachment -> ()
rnf CreateConnectAttachment' {Maybe [Tag]
Maybe Text
Text
ConnectAttachmentOptions
options :: ConnectAttachmentOptions
transportAttachmentId :: Text
edgeLocation :: Text
coreNetworkId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:options:CreateConnectAttachment' :: CreateConnectAttachment -> ConnectAttachmentOptions
$sel:transportAttachmentId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:edgeLocation:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:coreNetworkId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:tags:CreateConnectAttachment' :: CreateConnectAttachment -> Maybe [Tag]
$sel:clientToken:CreateConnectAttachment' :: CreateConnectAttachment -> 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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
coreNetworkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
edgeLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
transportAttachmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectAttachmentOptions
options

instance Data.ToHeaders CreateConnectAttachment where
  toHeaders :: CreateConnectAttachment -> 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 CreateConnectAttachment where
  toJSON :: CreateConnectAttachment -> Value
toJSON CreateConnectAttachment' {Maybe [Tag]
Maybe Text
Text
ConnectAttachmentOptions
options :: ConnectAttachmentOptions
transportAttachmentId :: Text
edgeLocation :: Text
coreNetworkId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:options:CreateConnectAttachment' :: CreateConnectAttachment -> ConnectAttachmentOptions
$sel:transportAttachmentId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:edgeLocation:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:coreNetworkId:CreateConnectAttachment' :: CreateConnectAttachment -> Text
$sel:tags:CreateConnectAttachment' :: CreateConnectAttachment -> Maybe [Tag]
$sel:clientToken:CreateConnectAttachment' :: CreateConnectAttachment -> 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"CoreNetworkId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
coreNetworkId),
            forall a. a -> Maybe a
Prelude.Just (Key
"EdgeLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
edgeLocation),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TransportAttachmentId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transportAttachmentId
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConnectAttachmentOptions
options)
          ]
      )

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

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

-- | /See:/ 'newCreateConnectAttachmentResponse' smart constructor.
data CreateConnectAttachmentResponse = CreateConnectAttachmentResponse'
  { -- | The response to a Connect attachment request.
    CreateConnectAttachmentResponse -> Maybe ConnectAttachment
connectAttachment :: Prelude.Maybe ConnectAttachment,
    -- | The response's http status code.
    CreateConnectAttachmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateConnectAttachmentResponse
-> CreateConnectAttachmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnectAttachmentResponse
-> CreateConnectAttachmentResponse -> Bool
$c/= :: CreateConnectAttachmentResponse
-> CreateConnectAttachmentResponse -> Bool
== :: CreateConnectAttachmentResponse
-> CreateConnectAttachmentResponse -> Bool
$c== :: CreateConnectAttachmentResponse
-> CreateConnectAttachmentResponse -> Bool
Prelude.Eq, ReadPrec [CreateConnectAttachmentResponse]
ReadPrec CreateConnectAttachmentResponse
Int -> ReadS CreateConnectAttachmentResponse
ReadS [CreateConnectAttachmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnectAttachmentResponse]
$creadListPrec :: ReadPrec [CreateConnectAttachmentResponse]
readPrec :: ReadPrec CreateConnectAttachmentResponse
$creadPrec :: ReadPrec CreateConnectAttachmentResponse
readList :: ReadS [CreateConnectAttachmentResponse]
$creadList :: ReadS [CreateConnectAttachmentResponse]
readsPrec :: Int -> ReadS CreateConnectAttachmentResponse
$creadsPrec :: Int -> ReadS CreateConnectAttachmentResponse
Prelude.Read, Int -> CreateConnectAttachmentResponse -> ShowS
[CreateConnectAttachmentResponse] -> ShowS
CreateConnectAttachmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnectAttachmentResponse] -> ShowS
$cshowList :: [CreateConnectAttachmentResponse] -> ShowS
show :: CreateConnectAttachmentResponse -> String
$cshow :: CreateConnectAttachmentResponse -> String
showsPrec :: Int -> CreateConnectAttachmentResponse -> ShowS
$cshowsPrec :: Int -> CreateConnectAttachmentResponse -> ShowS
Prelude.Show, forall x.
Rep CreateConnectAttachmentResponse x
-> CreateConnectAttachmentResponse
forall x.
CreateConnectAttachmentResponse
-> Rep CreateConnectAttachmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateConnectAttachmentResponse x
-> CreateConnectAttachmentResponse
$cfrom :: forall x.
CreateConnectAttachmentResponse
-> Rep CreateConnectAttachmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnectAttachmentResponse' 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:
--
-- 'connectAttachment', 'createConnectAttachmentResponse_connectAttachment' - The response to a Connect attachment request.
--
-- 'httpStatus', 'createConnectAttachmentResponse_httpStatus' - The response's http status code.
newCreateConnectAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateConnectAttachmentResponse
newCreateConnectAttachmentResponse :: Int -> CreateConnectAttachmentResponse
newCreateConnectAttachmentResponse Int
pHttpStatus_ =
  CreateConnectAttachmentResponse'
    { $sel:connectAttachment:CreateConnectAttachmentResponse' :: Maybe ConnectAttachment
connectAttachment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateConnectAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The response to a Connect attachment request.
createConnectAttachmentResponse_connectAttachment :: Lens.Lens' CreateConnectAttachmentResponse (Prelude.Maybe ConnectAttachment)
createConnectAttachmentResponse_connectAttachment :: Lens' CreateConnectAttachmentResponse (Maybe ConnectAttachment)
createConnectAttachmentResponse_connectAttachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectAttachmentResponse' {Maybe ConnectAttachment
connectAttachment :: Maybe ConnectAttachment
$sel:connectAttachment:CreateConnectAttachmentResponse' :: CreateConnectAttachmentResponse -> Maybe ConnectAttachment
connectAttachment} -> Maybe ConnectAttachment
connectAttachment) (\s :: CreateConnectAttachmentResponse
s@CreateConnectAttachmentResponse' {} Maybe ConnectAttachment
a -> CreateConnectAttachmentResponse
s {$sel:connectAttachment:CreateConnectAttachmentResponse' :: Maybe ConnectAttachment
connectAttachment = Maybe ConnectAttachment
a} :: CreateConnectAttachmentResponse)

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

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