{-# 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.OpenSearch.CreateOutboundConnection
-- 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 new cross-cluster search connection from a source Amazon
-- OpenSearch Service domain to a destination domain. For more information,
-- see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/cross-cluster-search.html Cross-cluster search for Amazon OpenSearch Service>.
module Amazonka.OpenSearch.CreateOutboundConnection
  ( -- * Creating a Request
    CreateOutboundConnection (..),
    newCreateOutboundConnection,

    -- * Request Lenses
    createOutboundConnection_localDomainInfo,
    createOutboundConnection_remoteDomainInfo,
    createOutboundConnection_connectionAlias,

    -- * Destructuring the Response
    CreateOutboundConnectionResponse (..),
    newCreateOutboundConnectionResponse,

    -- * Response Lenses
    createOutboundConnectionResponse_connectionAlias,
    createOutboundConnectionResponse_connectionId,
    createOutboundConnectionResponse_connectionStatus,
    createOutboundConnectionResponse_localDomainInfo,
    createOutboundConnectionResponse_remoteDomainInfo,
    createOutboundConnectionResponse_httpStatus,
  )
where

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

-- | Container for the parameters to the @CreateOutboundConnection@
-- operation.
--
-- /See:/ 'newCreateOutboundConnection' smart constructor.
data CreateOutboundConnection = CreateOutboundConnection'
  { -- | Name and Region of the source (local) domain.
    CreateOutboundConnection -> DomainInformationContainer
localDomainInfo :: DomainInformationContainer,
    -- | Name and Region of the destination (remote) domain.
    CreateOutboundConnection -> DomainInformationContainer
remoteDomainInfo :: DomainInformationContainer,
    -- | Name of the connection.
    CreateOutboundConnection -> Text
connectionAlias :: Prelude.Text
  }
  deriving (CreateOutboundConnection -> CreateOutboundConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOutboundConnection -> CreateOutboundConnection -> Bool
$c/= :: CreateOutboundConnection -> CreateOutboundConnection -> Bool
== :: CreateOutboundConnection -> CreateOutboundConnection -> Bool
$c== :: CreateOutboundConnection -> CreateOutboundConnection -> Bool
Prelude.Eq, ReadPrec [CreateOutboundConnection]
ReadPrec CreateOutboundConnection
Int -> ReadS CreateOutboundConnection
ReadS [CreateOutboundConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOutboundConnection]
$creadListPrec :: ReadPrec [CreateOutboundConnection]
readPrec :: ReadPrec CreateOutboundConnection
$creadPrec :: ReadPrec CreateOutboundConnection
readList :: ReadS [CreateOutboundConnection]
$creadList :: ReadS [CreateOutboundConnection]
readsPrec :: Int -> ReadS CreateOutboundConnection
$creadsPrec :: Int -> ReadS CreateOutboundConnection
Prelude.Read, Int -> CreateOutboundConnection -> ShowS
[CreateOutboundConnection] -> ShowS
CreateOutboundConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOutboundConnection] -> ShowS
$cshowList :: [CreateOutboundConnection] -> ShowS
show :: CreateOutboundConnection -> String
$cshow :: CreateOutboundConnection -> String
showsPrec :: Int -> CreateOutboundConnection -> ShowS
$cshowsPrec :: Int -> CreateOutboundConnection -> ShowS
Prelude.Show, forall x.
Rep CreateOutboundConnection x -> CreateOutboundConnection
forall x.
CreateOutboundConnection -> Rep CreateOutboundConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateOutboundConnection x -> CreateOutboundConnection
$cfrom :: forall x.
CreateOutboundConnection -> Rep CreateOutboundConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateOutboundConnection' 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:
--
-- 'localDomainInfo', 'createOutboundConnection_localDomainInfo' - Name and Region of the source (local) domain.
--
-- 'remoteDomainInfo', 'createOutboundConnection_remoteDomainInfo' - Name and Region of the destination (remote) domain.
--
-- 'connectionAlias', 'createOutboundConnection_connectionAlias' - Name of the connection.
newCreateOutboundConnection ::
  -- | 'localDomainInfo'
  DomainInformationContainer ->
  -- | 'remoteDomainInfo'
  DomainInformationContainer ->
  -- | 'connectionAlias'
  Prelude.Text ->
  CreateOutboundConnection
newCreateOutboundConnection :: DomainInformationContainer
-> DomainInformationContainer -> Text -> CreateOutboundConnection
newCreateOutboundConnection
  DomainInformationContainer
pLocalDomainInfo_
  DomainInformationContainer
pRemoteDomainInfo_
  Text
pConnectionAlias_ =
    CreateOutboundConnection'
      { $sel:localDomainInfo:CreateOutboundConnection' :: DomainInformationContainer
localDomainInfo =
          DomainInformationContainer
pLocalDomainInfo_,
        $sel:remoteDomainInfo:CreateOutboundConnection' :: DomainInformationContainer
remoteDomainInfo = DomainInformationContainer
pRemoteDomainInfo_,
        $sel:connectionAlias:CreateOutboundConnection' :: Text
connectionAlias = Text
pConnectionAlias_
      }

-- | Name and Region of the source (local) domain.
createOutboundConnection_localDomainInfo :: Lens.Lens' CreateOutboundConnection DomainInformationContainer
createOutboundConnection_localDomainInfo :: Lens' CreateOutboundConnection DomainInformationContainer
createOutboundConnection_localDomainInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnection' {DomainInformationContainer
localDomainInfo :: DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
localDomainInfo} -> DomainInformationContainer
localDomainInfo) (\s :: CreateOutboundConnection
s@CreateOutboundConnection' {} DomainInformationContainer
a -> CreateOutboundConnection
s {$sel:localDomainInfo:CreateOutboundConnection' :: DomainInformationContainer
localDomainInfo = DomainInformationContainer
a} :: CreateOutboundConnection)

-- | Name and Region of the destination (remote) domain.
createOutboundConnection_remoteDomainInfo :: Lens.Lens' CreateOutboundConnection DomainInformationContainer
createOutboundConnection_remoteDomainInfo :: Lens' CreateOutboundConnection DomainInformationContainer
createOutboundConnection_remoteDomainInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnection' {DomainInformationContainer
remoteDomainInfo :: DomainInformationContainer
$sel:remoteDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
remoteDomainInfo} -> DomainInformationContainer
remoteDomainInfo) (\s :: CreateOutboundConnection
s@CreateOutboundConnection' {} DomainInformationContainer
a -> CreateOutboundConnection
s {$sel:remoteDomainInfo:CreateOutboundConnection' :: DomainInformationContainer
remoteDomainInfo = DomainInformationContainer
a} :: CreateOutboundConnection)

-- | Name of the connection.
createOutboundConnection_connectionAlias :: Lens.Lens' CreateOutboundConnection Prelude.Text
createOutboundConnection_connectionAlias :: Lens' CreateOutboundConnection Text
createOutboundConnection_connectionAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnection' {Text
connectionAlias :: Text
$sel:connectionAlias:CreateOutboundConnection' :: CreateOutboundConnection -> Text
connectionAlias} -> Text
connectionAlias) (\s :: CreateOutboundConnection
s@CreateOutboundConnection' {} Text
a -> CreateOutboundConnection
s {$sel:connectionAlias:CreateOutboundConnection' :: Text
connectionAlias = Text
a} :: CreateOutboundConnection)

instance Core.AWSRequest CreateOutboundConnection where
  type
    AWSResponse CreateOutboundConnection =
      CreateOutboundConnectionResponse
  request :: (Service -> Service)
-> CreateOutboundConnection -> Request CreateOutboundConnection
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 CreateOutboundConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateOutboundConnection)))
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
-> Maybe Text
-> Maybe OutboundConnectionStatus
-> Maybe DomainInformationContainer
-> Maybe DomainInformationContainer
-> Int
-> CreateOutboundConnectionResponse
CreateOutboundConnectionResponse'
            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
"ConnectionAlias")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConnectionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConnectionStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LocalDomainInfo")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RemoteDomainInfo")
            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 CreateOutboundConnection where
  hashWithSalt :: Int -> CreateOutboundConnection -> Int
hashWithSalt Int
_salt CreateOutboundConnection' {Text
DomainInformationContainer
connectionAlias :: Text
remoteDomainInfo :: DomainInformationContainer
localDomainInfo :: DomainInformationContainer
$sel:connectionAlias:CreateOutboundConnection' :: CreateOutboundConnection -> Text
$sel:remoteDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DomainInformationContainer
localDomainInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DomainInformationContainer
remoteDomainInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionAlias

instance Prelude.NFData CreateOutboundConnection where
  rnf :: CreateOutboundConnection -> ()
rnf CreateOutboundConnection' {Text
DomainInformationContainer
connectionAlias :: Text
remoteDomainInfo :: DomainInformationContainer
localDomainInfo :: DomainInformationContainer
$sel:connectionAlias:CreateOutboundConnection' :: CreateOutboundConnection -> Text
$sel:remoteDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf DomainInformationContainer
localDomainInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DomainInformationContainer
remoteDomainInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionAlias

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

instance Data.ToJSON CreateOutboundConnection where
  toJSON :: CreateOutboundConnection -> Value
toJSON CreateOutboundConnection' {Text
DomainInformationContainer
connectionAlias :: Text
remoteDomainInfo :: DomainInformationContainer
localDomainInfo :: DomainInformationContainer
$sel:connectionAlias:CreateOutboundConnection' :: CreateOutboundConnection -> Text
$sel:remoteDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnection' :: CreateOutboundConnection -> DomainInformationContainer
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"LocalDomainInfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DomainInformationContainer
localDomainInfo),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RemoteDomainInfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DomainInformationContainer
remoteDomainInfo),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ConnectionAlias" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectionAlias)
          ]
      )

instance Data.ToPath CreateOutboundConnection where
  toPath :: CreateOutboundConnection -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/2021-01-01/opensearch/cc/outboundConnection"

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

-- | The result of a @CreateOutboundConnection@ request. Contains details
-- about the newly created cross-cluster connection.
--
-- /See:/ 'newCreateOutboundConnectionResponse' smart constructor.
data CreateOutboundConnectionResponse = CreateOutboundConnectionResponse'
  { -- | Name of the connection.
    CreateOutboundConnectionResponse -> Maybe Text
connectionAlias :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the created outbound connection, which is used
    -- for subsequent operations on the connection.
    CreateOutboundConnectionResponse -> Maybe Text
connectionId :: Prelude.Maybe Prelude.Text,
    -- | The status of the connection.
    CreateOutboundConnectionResponse -> Maybe OutboundConnectionStatus
connectionStatus :: Prelude.Maybe OutboundConnectionStatus,
    -- | Information about the source (local) domain.
    CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
localDomainInfo :: Prelude.Maybe DomainInformationContainer,
    -- | Information about the destination (remote) domain.
    CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
remoteDomainInfo :: Prelude.Maybe DomainInformationContainer,
    -- | The response's http status code.
    CreateOutboundConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateOutboundConnectionResponse
-> CreateOutboundConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOutboundConnectionResponse
-> CreateOutboundConnectionResponse -> Bool
$c/= :: CreateOutboundConnectionResponse
-> CreateOutboundConnectionResponse -> Bool
== :: CreateOutboundConnectionResponse
-> CreateOutboundConnectionResponse -> Bool
$c== :: CreateOutboundConnectionResponse
-> CreateOutboundConnectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateOutboundConnectionResponse]
ReadPrec CreateOutboundConnectionResponse
Int -> ReadS CreateOutboundConnectionResponse
ReadS [CreateOutboundConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOutboundConnectionResponse]
$creadListPrec :: ReadPrec [CreateOutboundConnectionResponse]
readPrec :: ReadPrec CreateOutboundConnectionResponse
$creadPrec :: ReadPrec CreateOutboundConnectionResponse
readList :: ReadS [CreateOutboundConnectionResponse]
$creadList :: ReadS [CreateOutboundConnectionResponse]
readsPrec :: Int -> ReadS CreateOutboundConnectionResponse
$creadsPrec :: Int -> ReadS CreateOutboundConnectionResponse
Prelude.Read, Int -> CreateOutboundConnectionResponse -> ShowS
[CreateOutboundConnectionResponse] -> ShowS
CreateOutboundConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOutboundConnectionResponse] -> ShowS
$cshowList :: [CreateOutboundConnectionResponse] -> ShowS
show :: CreateOutboundConnectionResponse -> String
$cshow :: CreateOutboundConnectionResponse -> String
showsPrec :: Int -> CreateOutboundConnectionResponse -> ShowS
$cshowsPrec :: Int -> CreateOutboundConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateOutboundConnectionResponse x
-> CreateOutboundConnectionResponse
forall x.
CreateOutboundConnectionResponse
-> Rep CreateOutboundConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateOutboundConnectionResponse x
-> CreateOutboundConnectionResponse
$cfrom :: forall x.
CreateOutboundConnectionResponse
-> Rep CreateOutboundConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateOutboundConnectionResponse' 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:
--
-- 'connectionAlias', 'createOutboundConnectionResponse_connectionAlias' - Name of the connection.
--
-- 'connectionId', 'createOutboundConnectionResponse_connectionId' - The unique identifier for the created outbound connection, which is used
-- for subsequent operations on the connection.
--
-- 'connectionStatus', 'createOutboundConnectionResponse_connectionStatus' - The status of the connection.
--
-- 'localDomainInfo', 'createOutboundConnectionResponse_localDomainInfo' - Information about the source (local) domain.
--
-- 'remoteDomainInfo', 'createOutboundConnectionResponse_remoteDomainInfo' - Information about the destination (remote) domain.
--
-- 'httpStatus', 'createOutboundConnectionResponse_httpStatus' - The response's http status code.
newCreateOutboundConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOutboundConnectionResponse
newCreateOutboundConnectionResponse :: Int -> CreateOutboundConnectionResponse
newCreateOutboundConnectionResponse Int
pHttpStatus_ =
  CreateOutboundConnectionResponse'
    { $sel:connectionAlias:CreateOutboundConnectionResponse' :: Maybe Text
connectionAlias =
        forall a. Maybe a
Prelude.Nothing,
      $sel:connectionId:CreateOutboundConnectionResponse' :: Maybe Text
connectionId = forall a. Maybe a
Prelude.Nothing,
      $sel:connectionStatus:CreateOutboundConnectionResponse' :: Maybe OutboundConnectionStatus
connectionStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:localDomainInfo:CreateOutboundConnectionResponse' :: Maybe DomainInformationContainer
localDomainInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteDomainInfo:CreateOutboundConnectionResponse' :: Maybe DomainInformationContainer
remoteDomainInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOutboundConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Name of the connection.
createOutboundConnectionResponse_connectionAlias :: Lens.Lens' CreateOutboundConnectionResponse (Prelude.Maybe Prelude.Text)
createOutboundConnectionResponse_connectionAlias :: Lens' CreateOutboundConnectionResponse (Maybe Text)
createOutboundConnectionResponse_connectionAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnectionResponse' {Maybe Text
connectionAlias :: Maybe Text
$sel:connectionAlias:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe Text
connectionAlias} -> Maybe Text
connectionAlias) (\s :: CreateOutboundConnectionResponse
s@CreateOutboundConnectionResponse' {} Maybe Text
a -> CreateOutboundConnectionResponse
s {$sel:connectionAlias:CreateOutboundConnectionResponse' :: Maybe Text
connectionAlias = Maybe Text
a} :: CreateOutboundConnectionResponse)

-- | The unique identifier for the created outbound connection, which is used
-- for subsequent operations on the connection.
createOutboundConnectionResponse_connectionId :: Lens.Lens' CreateOutboundConnectionResponse (Prelude.Maybe Prelude.Text)
createOutboundConnectionResponse_connectionId :: Lens' CreateOutboundConnectionResponse (Maybe Text)
createOutboundConnectionResponse_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnectionResponse' {Maybe Text
connectionId :: Maybe Text
$sel:connectionId:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe Text
connectionId} -> Maybe Text
connectionId) (\s :: CreateOutboundConnectionResponse
s@CreateOutboundConnectionResponse' {} Maybe Text
a -> CreateOutboundConnectionResponse
s {$sel:connectionId:CreateOutboundConnectionResponse' :: Maybe Text
connectionId = Maybe Text
a} :: CreateOutboundConnectionResponse)

-- | The status of the connection.
createOutboundConnectionResponse_connectionStatus :: Lens.Lens' CreateOutboundConnectionResponse (Prelude.Maybe OutboundConnectionStatus)
createOutboundConnectionResponse_connectionStatus :: Lens'
  CreateOutboundConnectionResponse (Maybe OutboundConnectionStatus)
createOutboundConnectionResponse_connectionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnectionResponse' {Maybe OutboundConnectionStatus
connectionStatus :: Maybe OutboundConnectionStatus
$sel:connectionStatus:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe OutboundConnectionStatus
connectionStatus} -> Maybe OutboundConnectionStatus
connectionStatus) (\s :: CreateOutboundConnectionResponse
s@CreateOutboundConnectionResponse' {} Maybe OutboundConnectionStatus
a -> CreateOutboundConnectionResponse
s {$sel:connectionStatus:CreateOutboundConnectionResponse' :: Maybe OutboundConnectionStatus
connectionStatus = Maybe OutboundConnectionStatus
a} :: CreateOutboundConnectionResponse)

-- | Information about the source (local) domain.
createOutboundConnectionResponse_localDomainInfo :: Lens.Lens' CreateOutboundConnectionResponse (Prelude.Maybe DomainInformationContainer)
createOutboundConnectionResponse_localDomainInfo :: Lens'
  CreateOutboundConnectionResponse (Maybe DomainInformationContainer)
createOutboundConnectionResponse_localDomainInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnectionResponse' {Maybe DomainInformationContainer
localDomainInfo :: Maybe DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
localDomainInfo} -> Maybe DomainInformationContainer
localDomainInfo) (\s :: CreateOutboundConnectionResponse
s@CreateOutboundConnectionResponse' {} Maybe DomainInformationContainer
a -> CreateOutboundConnectionResponse
s {$sel:localDomainInfo:CreateOutboundConnectionResponse' :: Maybe DomainInformationContainer
localDomainInfo = Maybe DomainInformationContainer
a} :: CreateOutboundConnectionResponse)

-- | Information about the destination (remote) domain.
createOutboundConnectionResponse_remoteDomainInfo :: Lens.Lens' CreateOutboundConnectionResponse (Prelude.Maybe DomainInformationContainer)
createOutboundConnectionResponse_remoteDomainInfo :: Lens'
  CreateOutboundConnectionResponse (Maybe DomainInformationContainer)
createOutboundConnectionResponse_remoteDomainInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutboundConnectionResponse' {Maybe DomainInformationContainer
remoteDomainInfo :: Maybe DomainInformationContainer
$sel:remoteDomainInfo:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
remoteDomainInfo} -> Maybe DomainInformationContainer
remoteDomainInfo) (\s :: CreateOutboundConnectionResponse
s@CreateOutboundConnectionResponse' {} Maybe DomainInformationContainer
a -> CreateOutboundConnectionResponse
s {$sel:remoteDomainInfo:CreateOutboundConnectionResponse' :: Maybe DomainInformationContainer
remoteDomainInfo = Maybe DomainInformationContainer
a} :: CreateOutboundConnectionResponse)

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

instance
  Prelude.NFData
    CreateOutboundConnectionResponse
  where
  rnf :: CreateOutboundConnectionResponse -> ()
rnf CreateOutboundConnectionResponse' {Int
Maybe Text
Maybe DomainInformationContainer
Maybe OutboundConnectionStatus
httpStatus :: Int
remoteDomainInfo :: Maybe DomainInformationContainer
localDomainInfo :: Maybe DomainInformationContainer
connectionStatus :: Maybe OutboundConnectionStatus
connectionId :: Maybe Text
connectionAlias :: Maybe Text
$sel:httpStatus:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Int
$sel:remoteDomainInfo:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
$sel:localDomainInfo:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse
-> Maybe DomainInformationContainer
$sel:connectionStatus:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe OutboundConnectionStatus
$sel:connectionId:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe Text
$sel:connectionAlias:CreateOutboundConnectionResponse' :: CreateOutboundConnectionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutboundConnectionStatus
connectionStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainInformationContainer
localDomainInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainInformationContainer
remoteDomainInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus