{-# 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.RejectInboundConnection
-- 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 remote Amazon OpenSearch Service domain owner to reject an
-- inbound cross-cluster connection request.
module Amazonka.OpenSearch.RejectInboundConnection
  ( -- * Creating a Request
    RejectInboundConnection (..),
    newRejectInboundConnection,

    -- * Request Lenses
    rejectInboundConnection_connectionId,

    -- * Destructuring the Response
    RejectInboundConnectionResponse (..),
    newRejectInboundConnectionResponse,

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

-- |
-- Create a value of 'RejectInboundConnection' 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', 'rejectInboundConnection_connectionId' - The unique identifier of the inbound connection to reject.
newRejectInboundConnection ::
  -- | 'connectionId'
  Prelude.Text ->
  RejectInboundConnection
newRejectInboundConnection :: Text -> RejectInboundConnection
newRejectInboundConnection Text
pConnectionId_ =
  RejectInboundConnection'
    { $sel:connectionId:RejectInboundConnection' :: Text
connectionId =
        Text
pConnectionId_
    }

-- | The unique identifier of the inbound connection to reject.
rejectInboundConnection_connectionId :: Lens.Lens' RejectInboundConnection Prelude.Text
rejectInboundConnection_connectionId :: Lens' RejectInboundConnection Text
rejectInboundConnection_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectInboundConnection' {Text
connectionId :: Text
$sel:connectionId:RejectInboundConnection' :: RejectInboundConnection -> Text
connectionId} -> Text
connectionId) (\s :: RejectInboundConnection
s@RejectInboundConnection' {} Text
a -> RejectInboundConnection
s {$sel:connectionId:RejectInboundConnection' :: Text
connectionId = Text
a} :: RejectInboundConnection)

instance Core.AWSRequest RejectInboundConnection where
  type
    AWSResponse RejectInboundConnection =
      RejectInboundConnectionResponse
  request :: (Service -> Service)
-> RejectInboundConnection -> Request RejectInboundConnection
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 RejectInboundConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RejectInboundConnection)))
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 -> RejectInboundConnectionResponse
RejectInboundConnectionResponse'
            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 RejectInboundConnection where
  hashWithSalt :: Int -> RejectInboundConnection -> Int
hashWithSalt Int
_salt RejectInboundConnection' {Text
connectionId :: Text
$sel:connectionId:RejectInboundConnection' :: RejectInboundConnection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionId

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

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

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

instance Data.ToPath RejectInboundConnection where
  toPath :: RejectInboundConnection -> ByteString
toPath RejectInboundConnection' {Text
connectionId :: Text
$sel:connectionId:RejectInboundConnection' :: RejectInboundConnection -> 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
"/reject"
      ]

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

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

-- |
-- Create a value of 'RejectInboundConnectionResponse' 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', 'rejectInboundConnectionResponse_connection' - Contains details about the rejected inbound connection.
--
-- 'httpStatus', 'rejectInboundConnectionResponse_httpStatus' - The response's http status code.
newRejectInboundConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RejectInboundConnectionResponse
newRejectInboundConnectionResponse :: Int -> RejectInboundConnectionResponse
newRejectInboundConnectionResponse Int
pHttpStatus_ =
  RejectInboundConnectionResponse'
    { $sel:connection:RejectInboundConnectionResponse' :: Maybe InboundConnection
connection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RejectInboundConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains details about the rejected inbound connection.
rejectInboundConnectionResponse_connection :: Lens.Lens' RejectInboundConnectionResponse (Prelude.Maybe InboundConnection)
rejectInboundConnectionResponse_connection :: Lens' RejectInboundConnectionResponse (Maybe InboundConnection)
rejectInboundConnectionResponse_connection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectInboundConnectionResponse' {Maybe InboundConnection
connection :: Maybe InboundConnection
$sel:connection:RejectInboundConnectionResponse' :: RejectInboundConnectionResponse -> Maybe InboundConnection
connection} -> Maybe InboundConnection
connection) (\s :: RejectInboundConnectionResponse
s@RejectInboundConnectionResponse' {} Maybe InboundConnection
a -> RejectInboundConnectionResponse
s {$sel:connection:RejectInboundConnectionResponse' :: Maybe InboundConnection
connection = Maybe InboundConnection
a} :: RejectInboundConnectionResponse)

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

instance
  Prelude.NFData
    RejectInboundConnectionResponse
  where
  rnf :: RejectInboundConnectionResponse -> ()
rnf RejectInboundConnectionResponse' {Int
Maybe InboundConnection
httpStatus :: Int
connection :: Maybe InboundConnection
$sel:httpStatus:RejectInboundConnectionResponse' :: RejectInboundConnectionResponse -> Int
$sel:connection:RejectInboundConnectionResponse' :: RejectInboundConnectionResponse -> 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