{-# 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.CodeStarConnections.CreateConnection
-- 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 connection that can then be given to other AWS services like
-- CodePipeline so that it can access third-party code repositories. The
-- connection is in pending status until the third-party connection
-- handshake is completed from the console.
module Amazonka.CodeStarConnections.CreateConnection
  ( -- * Creating a Request
    CreateConnection (..),
    newCreateConnection,

    -- * Request Lenses
    createConnection_hostArn,
    createConnection_providerType,
    createConnection_tags,
    createConnection_connectionName,

    -- * Destructuring the Response
    CreateConnectionResponse (..),
    newCreateConnectionResponse,

    -- * Response Lenses
    createConnectionResponse_tags,
    createConnectionResponse_httpStatus,
    createConnectionResponse_connectionArn,
  )
where

import Amazonka.CodeStarConnections.Types
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

-- | /See:/ 'newCreateConnection' smart constructor.
data CreateConnection = CreateConnection'
  { -- | The Amazon Resource Name (ARN) of the host associated with the
    -- connection to be created.
    CreateConnection -> Maybe Text
hostArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the external provider where your third-party code repository
    -- is configured.
    CreateConnection -> Maybe ProviderType
providerType :: Prelude.Maybe ProviderType,
    -- | The key-value pair to use when tagging the resource.
    CreateConnection -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the connection to be created. The name must be unique in the
    -- calling AWS account.
    CreateConnection -> Text
connectionName :: Prelude.Text
  }
  deriving (CreateConnection -> CreateConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnection -> CreateConnection -> Bool
$c/= :: CreateConnection -> CreateConnection -> Bool
== :: CreateConnection -> CreateConnection -> Bool
$c== :: CreateConnection -> CreateConnection -> Bool
Prelude.Eq, ReadPrec [CreateConnection]
ReadPrec CreateConnection
Int -> ReadS CreateConnection
ReadS [CreateConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnection]
$creadListPrec :: ReadPrec [CreateConnection]
readPrec :: ReadPrec CreateConnection
$creadPrec :: ReadPrec CreateConnection
readList :: ReadS [CreateConnection]
$creadList :: ReadS [CreateConnection]
readsPrec :: Int -> ReadS CreateConnection
$creadsPrec :: Int -> ReadS CreateConnection
Prelude.Read, Int -> CreateConnection -> ShowS
[CreateConnection] -> ShowS
CreateConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnection] -> ShowS
$cshowList :: [CreateConnection] -> ShowS
show :: CreateConnection -> String
$cshow :: CreateConnection -> String
showsPrec :: Int -> CreateConnection -> ShowS
$cshowsPrec :: Int -> CreateConnection -> ShowS
Prelude.Show, forall x. Rep CreateConnection x -> CreateConnection
forall x. CreateConnection -> Rep CreateConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnection x -> CreateConnection
$cfrom :: forall x. CreateConnection -> Rep CreateConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnection' 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:
--
-- 'hostArn', 'createConnection_hostArn' - The Amazon Resource Name (ARN) of the host associated with the
-- connection to be created.
--
-- 'providerType', 'createConnection_providerType' - The name of the external provider where your third-party code repository
-- is configured.
--
-- 'tags', 'createConnection_tags' - The key-value pair to use when tagging the resource.
--
-- 'connectionName', 'createConnection_connectionName' - The name of the connection to be created. The name must be unique in the
-- calling AWS account.
newCreateConnection ::
  -- | 'connectionName'
  Prelude.Text ->
  CreateConnection
newCreateConnection :: Text -> CreateConnection
newCreateConnection Text
pConnectionName_ =
  CreateConnection'
    { $sel:hostArn:CreateConnection' :: Maybe Text
hostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:providerType:CreateConnection' :: Maybe ProviderType
providerType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateConnection' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:connectionName:CreateConnection' :: Text
connectionName = Text
pConnectionName_
    }

-- | The Amazon Resource Name (ARN) of the host associated with the
-- connection to be created.
createConnection_hostArn :: Lens.Lens' CreateConnection (Prelude.Maybe Prelude.Text)
createConnection_hostArn :: Lens' CreateConnection (Maybe Text)
createConnection_hostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Maybe Text
hostArn :: Maybe Text
$sel:hostArn:CreateConnection' :: CreateConnection -> Maybe Text
hostArn} -> Maybe Text
hostArn) (\s :: CreateConnection
s@CreateConnection' {} Maybe Text
a -> CreateConnection
s {$sel:hostArn:CreateConnection' :: Maybe Text
hostArn = Maybe Text
a} :: CreateConnection)

-- | The name of the external provider where your third-party code repository
-- is configured.
createConnection_providerType :: Lens.Lens' CreateConnection (Prelude.Maybe ProviderType)
createConnection_providerType :: Lens' CreateConnection (Maybe ProviderType)
createConnection_providerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Maybe ProviderType
providerType :: Maybe ProviderType
$sel:providerType:CreateConnection' :: CreateConnection -> Maybe ProviderType
providerType} -> Maybe ProviderType
providerType) (\s :: CreateConnection
s@CreateConnection' {} Maybe ProviderType
a -> CreateConnection
s {$sel:providerType:CreateConnection' :: Maybe ProviderType
providerType = Maybe ProviderType
a} :: CreateConnection)

-- | The key-value pair to use when tagging the resource.
createConnection_tags :: Lens.Lens' CreateConnection (Prelude.Maybe [Tag])
createConnection_tags :: Lens' CreateConnection (Maybe [Tag])
createConnection_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateConnection' :: CreateConnection -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateConnection
s@CreateConnection' {} Maybe [Tag]
a -> CreateConnection
s {$sel:tags:CreateConnection' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateConnection) 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 name of the connection to be created. The name must be unique in the
-- calling AWS account.
createConnection_connectionName :: Lens.Lens' CreateConnection Prelude.Text
createConnection_connectionName :: Lens' CreateConnection Text
createConnection_connectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Text
connectionName :: Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
connectionName} -> Text
connectionName) (\s :: CreateConnection
s@CreateConnection' {} Text
a -> CreateConnection
s {$sel:connectionName:CreateConnection' :: Text
connectionName = Text
a} :: CreateConnection)

instance Core.AWSRequest CreateConnection where
  type
    AWSResponse CreateConnection =
      CreateConnectionResponse
  request :: (Service -> Service)
-> CreateConnection -> Request CreateConnection
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 CreateConnection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateConnection)))
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 [Tag] -> Int -> Text -> CreateConnectionResponse
CreateConnectionResponse'
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            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
"ConnectionArn")
      )

instance Prelude.Hashable CreateConnection where
  hashWithSalt :: Int -> CreateConnection -> Int
hashWithSalt Int
_salt CreateConnection' {Maybe [Tag]
Maybe Text
Maybe ProviderType
Text
connectionName :: Text
tags :: Maybe [Tag]
providerType :: Maybe ProviderType
hostArn :: Maybe Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
$sel:tags:CreateConnection' :: CreateConnection -> Maybe [Tag]
$sel:providerType:CreateConnection' :: CreateConnection -> Maybe ProviderType
$sel:hostArn:CreateConnection' :: CreateConnection -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProviderType
providerType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionName

instance Prelude.NFData CreateConnection where
  rnf :: CreateConnection -> ()
rnf CreateConnection' {Maybe [Tag]
Maybe Text
Maybe ProviderType
Text
connectionName :: Text
tags :: Maybe [Tag]
providerType :: Maybe ProviderType
hostArn :: Maybe Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
$sel:tags:CreateConnection' :: CreateConnection -> Maybe [Tag]
$sel:providerType:CreateConnection' :: CreateConnection -> Maybe ProviderType
$sel:hostArn:CreateConnection' :: CreateConnection -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProviderType
providerType
      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
connectionName

instance Data.ToHeaders CreateConnection where
  toHeaders :: CreateConnection -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"com.amazonaws.codestar.connections.CodeStar_connections_20191201.CreateConnection" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateConnection where
  toJSON :: CreateConnection -> Value
toJSON CreateConnection' {Maybe [Tag]
Maybe Text
Maybe ProviderType
Text
connectionName :: Text
tags :: Maybe [Tag]
providerType :: Maybe ProviderType
hostArn :: Maybe Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
$sel:tags:CreateConnection' :: CreateConnection -> Maybe [Tag]
$sel:providerType:CreateConnection' :: CreateConnection -> Maybe ProviderType
$sel:hostArn:CreateConnection' :: CreateConnection -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HostArn" 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
hostArn,
            (Key
"ProviderType" 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 ProviderType
providerType,
            (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
"ConnectionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectionName)
          ]
      )

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

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

-- | /See:/ 'newCreateConnectionResponse' smart constructor.
data CreateConnectionResponse = CreateConnectionResponse'
  { -- | Specifies the tags applied to the resource.
    CreateConnectionResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    CreateConnectionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the connection to be created. The ARN
    -- is used as the connection reference when the connection is shared
    -- between AWS services.
    --
    -- The ARN is never reused if the connection is deleted.
    CreateConnectionResponse -> Text
connectionArn :: Prelude.Text
  }
  deriving (CreateConnectionResponse -> CreateConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnectionResponse -> CreateConnectionResponse -> Bool
$c/= :: CreateConnectionResponse -> CreateConnectionResponse -> Bool
== :: CreateConnectionResponse -> CreateConnectionResponse -> Bool
$c== :: CreateConnectionResponse -> CreateConnectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateConnectionResponse]
ReadPrec CreateConnectionResponse
Int -> ReadS CreateConnectionResponse
ReadS [CreateConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnectionResponse]
$creadListPrec :: ReadPrec [CreateConnectionResponse]
readPrec :: ReadPrec CreateConnectionResponse
$creadPrec :: ReadPrec CreateConnectionResponse
readList :: ReadS [CreateConnectionResponse]
$creadList :: ReadS [CreateConnectionResponse]
readsPrec :: Int -> ReadS CreateConnectionResponse
$creadsPrec :: Int -> ReadS CreateConnectionResponse
Prelude.Read, Int -> CreateConnectionResponse -> ShowS
[CreateConnectionResponse] -> ShowS
CreateConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnectionResponse] -> ShowS
$cshowList :: [CreateConnectionResponse] -> ShowS
show :: CreateConnectionResponse -> String
$cshow :: CreateConnectionResponse -> String
showsPrec :: Int -> CreateConnectionResponse -> ShowS
$cshowsPrec :: Int -> CreateConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateConnectionResponse x -> CreateConnectionResponse
forall x.
CreateConnectionResponse -> Rep CreateConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateConnectionResponse x -> CreateConnectionResponse
$cfrom :: forall x.
CreateConnectionResponse -> Rep CreateConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnectionResponse' 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:
--
-- 'tags', 'createConnectionResponse_tags' - Specifies the tags applied to the resource.
--
-- 'httpStatus', 'createConnectionResponse_httpStatus' - The response's http status code.
--
-- 'connectionArn', 'createConnectionResponse_connectionArn' - The Amazon Resource Name (ARN) of the connection to be created. The ARN
-- is used as the connection reference when the connection is shared
-- between AWS services.
--
-- The ARN is never reused if the connection is deleted.
newCreateConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'connectionArn'
  Prelude.Text ->
  CreateConnectionResponse
newCreateConnectionResponse :: Int -> Text -> CreateConnectionResponse
newCreateConnectionResponse
  Int
pHttpStatus_
  Text
pConnectionArn_ =
    CreateConnectionResponse'
      { $sel:tags:CreateConnectionResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:connectionArn:CreateConnectionResponse' :: Text
connectionArn = Text
pConnectionArn_
      }

-- | Specifies the tags applied to the resource.
createConnectionResponse_tags :: Lens.Lens' CreateConnectionResponse (Prelude.Maybe [Tag])
createConnectionResponse_tags :: Lens' CreateConnectionResponse (Maybe [Tag])
createConnectionResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectionResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateConnectionResponse' :: CreateConnectionResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateConnectionResponse
s@CreateConnectionResponse' {} Maybe [Tag]
a -> CreateConnectionResponse
s {$sel:tags:CreateConnectionResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateConnectionResponse) 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 response's http status code.
createConnectionResponse_httpStatus :: Lens.Lens' CreateConnectionResponse Prelude.Int
createConnectionResponse_httpStatus :: Lens' CreateConnectionResponse Int
createConnectionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectionResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateConnectionResponse' :: CreateConnectionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateConnectionResponse
s@CreateConnectionResponse' {} Int
a -> CreateConnectionResponse
s {$sel:httpStatus:CreateConnectionResponse' :: Int
httpStatus = Int
a} :: CreateConnectionResponse)

-- | The Amazon Resource Name (ARN) of the connection to be created. The ARN
-- is used as the connection reference when the connection is shared
-- between AWS services.
--
-- The ARN is never reused if the connection is deleted.
createConnectionResponse_connectionArn :: Lens.Lens' CreateConnectionResponse Prelude.Text
createConnectionResponse_connectionArn :: Lens' CreateConnectionResponse Text
createConnectionResponse_connectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectionResponse' {Text
connectionArn :: Text
$sel:connectionArn:CreateConnectionResponse' :: CreateConnectionResponse -> Text
connectionArn} -> Text
connectionArn) (\s :: CreateConnectionResponse
s@CreateConnectionResponse' {} Text
a -> CreateConnectionResponse
s {$sel:connectionArn:CreateConnectionResponse' :: Text
connectionArn = Text
a} :: CreateConnectionResponse)

instance Prelude.NFData CreateConnectionResponse where
  rnf :: CreateConnectionResponse -> ()
rnf CreateConnectionResponse' {Int
Maybe [Tag]
Text
connectionArn :: Text
httpStatus :: Int
tags :: Maybe [Tag]
$sel:connectionArn:CreateConnectionResponse' :: CreateConnectionResponse -> Text
$sel:httpStatus:CreateConnectionResponse' :: CreateConnectionResponse -> Int
$sel:tags:CreateConnectionResponse' :: CreateConnectionResponse -> Maybe [Tag]
..} =
    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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionArn