{-# 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.AcceptInboundConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows the destination Amazon OpenSearch Service domain owner to accept
-- an inbound cross-cluster search connection request. 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.AcceptInboundConnection
  ( -- * Creating a Request
    AcceptInboundConnection (..),
    newAcceptInboundConnection,

    -- * Request Lenses
    acceptInboundConnection_connectionId,

    -- * Destructuring the Response
    AcceptInboundConnectionResponse (..),
    newAcceptInboundConnectionResponse,

    -- * Response Lenses
    acceptInboundConnectionResponse_connection,
    acceptInboundConnectionResponse_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 @AcceptInboundConnection@ operation.
--
-- /See:/ 'newAcceptInboundConnection' smart constructor.
data AcceptInboundConnection = AcceptInboundConnection'
  { -- | The ID of the inbound connection to accept.
    AcceptInboundConnection -> Text
connectionId :: Prelude.Text
  }
  deriving (AcceptInboundConnection -> AcceptInboundConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptInboundConnection -> AcceptInboundConnection -> Bool
$c/= :: AcceptInboundConnection -> AcceptInboundConnection -> Bool
== :: AcceptInboundConnection -> AcceptInboundConnection -> Bool
$c== :: AcceptInboundConnection -> AcceptInboundConnection -> Bool
Prelude.Eq, ReadPrec [AcceptInboundConnection]
ReadPrec AcceptInboundConnection
Int -> ReadS AcceptInboundConnection
ReadS [AcceptInboundConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptInboundConnection]
$creadListPrec :: ReadPrec [AcceptInboundConnection]
readPrec :: ReadPrec AcceptInboundConnection
$creadPrec :: ReadPrec AcceptInboundConnection
readList :: ReadS [AcceptInboundConnection]
$creadList :: ReadS [AcceptInboundConnection]
readsPrec :: Int -> ReadS AcceptInboundConnection
$creadsPrec :: Int -> ReadS AcceptInboundConnection
Prelude.Read, Int -> AcceptInboundConnection -> ShowS
[AcceptInboundConnection] -> ShowS
AcceptInboundConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptInboundConnection] -> ShowS
$cshowList :: [AcceptInboundConnection] -> ShowS
show :: AcceptInboundConnection -> String
$cshow :: AcceptInboundConnection -> String
showsPrec :: Int -> AcceptInboundConnection -> ShowS
$cshowsPrec :: Int -> AcceptInboundConnection -> ShowS
Prelude.Show, forall x. Rep AcceptInboundConnection x -> AcceptInboundConnection
forall x. AcceptInboundConnection -> Rep AcceptInboundConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptInboundConnection x -> AcceptInboundConnection
$cfrom :: forall x. AcceptInboundConnection -> Rep AcceptInboundConnection x
Prelude.Generic)

-- |
-- Create a value of 'AcceptInboundConnection' 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:
--
-- 'connectionId', 'acceptInboundConnection_connectionId' - The ID of the inbound connection to accept.
newAcceptInboundConnection ::
  -- | 'connectionId'
  Prelude.Text ->
  AcceptInboundConnection
newAcceptInboundConnection :: Text -> AcceptInboundConnection
newAcceptInboundConnection Text
pConnectionId_ =
  AcceptInboundConnection'
    { $sel:connectionId:AcceptInboundConnection' :: Text
connectionId =
        Text
pConnectionId_
    }

-- | The ID of the inbound connection to accept.
acceptInboundConnection_connectionId :: Lens.Lens' AcceptInboundConnection Prelude.Text
acceptInboundConnection_connectionId :: Lens' AcceptInboundConnection Text
acceptInboundConnection_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptInboundConnection' {Text
connectionId :: Text
$sel:connectionId:AcceptInboundConnection' :: AcceptInboundConnection -> Text
connectionId} -> Text
connectionId) (\s :: AcceptInboundConnection
s@AcceptInboundConnection' {} Text
a -> AcceptInboundConnection
s {$sel:connectionId:AcceptInboundConnection' :: Text
connectionId = Text
a} :: AcceptInboundConnection)

instance Core.AWSRequest AcceptInboundConnection where
  type
    AWSResponse AcceptInboundConnection =
      AcceptInboundConnectionResponse
  request :: (Service -> Service)
-> AcceptInboundConnection -> Request AcceptInboundConnection
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AcceptInboundConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AcceptInboundConnection)))
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 InboundConnection -> Int -> AcceptInboundConnectionResponse
AcceptInboundConnectionResponse'
            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
"Connection")
            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 AcceptInboundConnection where
  hashWithSalt :: Int -> AcceptInboundConnection -> Int
hashWithSalt Int
_salt AcceptInboundConnection' {Text
connectionId :: Text
$sel:connectionId:AcceptInboundConnection' :: AcceptInboundConnection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionId

instance Prelude.NFData AcceptInboundConnection where
  rnf :: AcceptInboundConnection -> ()
rnf AcceptInboundConnection' {Text
connectionId :: Text
$sel:connectionId:AcceptInboundConnection' :: AcceptInboundConnection -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
connectionId

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

instance Data.ToJSON AcceptInboundConnection where
  toJSON :: AcceptInboundConnection -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath AcceptInboundConnection where
  toPath :: AcceptInboundConnection -> ByteString
toPath AcceptInboundConnection' {Text
connectionId :: Text
$sel:connectionId:AcceptInboundConnection' :: AcceptInboundConnection -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2021-01-01/opensearch/cc/inboundConnection/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
connectionId,
        ByteString
"/accept"
      ]

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

-- | Contains details about the accepted inbound connection.
--
-- /See:/ 'newAcceptInboundConnectionResponse' smart constructor.
data AcceptInboundConnectionResponse = AcceptInboundConnectionResponse'
  { -- | Information about the accepted inbound connection.
    AcceptInboundConnectionResponse -> Maybe InboundConnection
connection :: Prelude.Maybe InboundConnection,
    -- | The response's http status code.
    AcceptInboundConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AcceptInboundConnectionResponse
-> AcceptInboundConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptInboundConnectionResponse
-> AcceptInboundConnectionResponse -> Bool
$c/= :: AcceptInboundConnectionResponse
-> AcceptInboundConnectionResponse -> Bool
== :: AcceptInboundConnectionResponse
-> AcceptInboundConnectionResponse -> Bool
$c== :: AcceptInboundConnectionResponse
-> AcceptInboundConnectionResponse -> Bool
Prelude.Eq, ReadPrec [AcceptInboundConnectionResponse]
ReadPrec AcceptInboundConnectionResponse
Int -> ReadS AcceptInboundConnectionResponse
ReadS [AcceptInboundConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptInboundConnectionResponse]
$creadListPrec :: ReadPrec [AcceptInboundConnectionResponse]
readPrec :: ReadPrec AcceptInboundConnectionResponse
$creadPrec :: ReadPrec AcceptInboundConnectionResponse
readList :: ReadS [AcceptInboundConnectionResponse]
$creadList :: ReadS [AcceptInboundConnectionResponse]
readsPrec :: Int -> ReadS AcceptInboundConnectionResponse
$creadsPrec :: Int -> ReadS AcceptInboundConnectionResponse
Prelude.Read, Int -> AcceptInboundConnectionResponse -> ShowS
[AcceptInboundConnectionResponse] -> ShowS
AcceptInboundConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptInboundConnectionResponse] -> ShowS
$cshowList :: [AcceptInboundConnectionResponse] -> ShowS
show :: AcceptInboundConnectionResponse -> String
$cshow :: AcceptInboundConnectionResponse -> String
showsPrec :: Int -> AcceptInboundConnectionResponse -> ShowS
$cshowsPrec :: Int -> AcceptInboundConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep AcceptInboundConnectionResponse x
-> AcceptInboundConnectionResponse
forall x.
AcceptInboundConnectionResponse
-> Rep AcceptInboundConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AcceptInboundConnectionResponse x
-> AcceptInboundConnectionResponse
$cfrom :: forall x.
AcceptInboundConnectionResponse
-> Rep AcceptInboundConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'AcceptInboundConnectionResponse' 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:
--
-- 'connection', 'acceptInboundConnectionResponse_connection' - Information about the accepted inbound connection.
--
-- 'httpStatus', 'acceptInboundConnectionResponse_httpStatus' - The response's http status code.
newAcceptInboundConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptInboundConnectionResponse
newAcceptInboundConnectionResponse :: Int -> AcceptInboundConnectionResponse
newAcceptInboundConnectionResponse Int
pHttpStatus_ =
  AcceptInboundConnectionResponse'
    { $sel:connection:AcceptInboundConnectionResponse' :: Maybe InboundConnection
connection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AcceptInboundConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the accepted inbound connection.
acceptInboundConnectionResponse_connection :: Lens.Lens' AcceptInboundConnectionResponse (Prelude.Maybe InboundConnection)
acceptInboundConnectionResponse_connection :: Lens' AcceptInboundConnectionResponse (Maybe InboundConnection)
acceptInboundConnectionResponse_connection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptInboundConnectionResponse' {Maybe InboundConnection
connection :: Maybe InboundConnection
$sel:connection:AcceptInboundConnectionResponse' :: AcceptInboundConnectionResponse -> Maybe InboundConnection
connection} -> Maybe InboundConnection
connection) (\s :: AcceptInboundConnectionResponse
s@AcceptInboundConnectionResponse' {} Maybe InboundConnection
a -> AcceptInboundConnectionResponse
s {$sel:connection:AcceptInboundConnectionResponse' :: Maybe InboundConnection
connection = Maybe InboundConnection
a} :: AcceptInboundConnectionResponse)

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

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