{-# 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.ElasticSearch.RejectInboundCrossClusterSearchConnection
-- 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 domain owner to reject an inbound cross-cluster
-- search connection request.
module Amazonka.ElasticSearch.RejectInboundCrossClusterSearchConnection
  ( -- * Creating a Request
    RejectInboundCrossClusterSearchConnection (..),
    newRejectInboundCrossClusterSearchConnection,

    -- * Request Lenses
    rejectInboundCrossClusterSearchConnection_crossClusterSearchConnectionId,

    -- * Destructuring the Response
    RejectInboundCrossClusterSearchConnectionResponse (..),
    newRejectInboundCrossClusterSearchConnectionResponse,

    -- * Response Lenses
    rejectInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection,
    rejectInboundCrossClusterSearchConnectionResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElasticSearch.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
-- @RejectInboundCrossClusterSearchConnection@ operation.
--
-- /See:/ 'newRejectInboundCrossClusterSearchConnection' smart constructor.
data RejectInboundCrossClusterSearchConnection = RejectInboundCrossClusterSearchConnection'
  { -- | The id of the inbound connection that you want to reject.
    RejectInboundCrossClusterSearchConnection -> Text
crossClusterSearchConnectionId :: Prelude.Text
  }
  deriving (RejectInboundCrossClusterSearchConnection
-> RejectInboundCrossClusterSearchConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectInboundCrossClusterSearchConnection
-> RejectInboundCrossClusterSearchConnection -> Bool
$c/= :: RejectInboundCrossClusterSearchConnection
-> RejectInboundCrossClusterSearchConnection -> Bool
== :: RejectInboundCrossClusterSearchConnection
-> RejectInboundCrossClusterSearchConnection -> Bool
$c== :: RejectInboundCrossClusterSearchConnection
-> RejectInboundCrossClusterSearchConnection -> Bool
Prelude.Eq, ReadPrec [RejectInboundCrossClusterSearchConnection]
ReadPrec RejectInboundCrossClusterSearchConnection
Int -> ReadS RejectInboundCrossClusterSearchConnection
ReadS [RejectInboundCrossClusterSearchConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RejectInboundCrossClusterSearchConnection]
$creadListPrec :: ReadPrec [RejectInboundCrossClusterSearchConnection]
readPrec :: ReadPrec RejectInboundCrossClusterSearchConnection
$creadPrec :: ReadPrec RejectInboundCrossClusterSearchConnection
readList :: ReadS [RejectInboundCrossClusterSearchConnection]
$creadList :: ReadS [RejectInboundCrossClusterSearchConnection]
readsPrec :: Int -> ReadS RejectInboundCrossClusterSearchConnection
$creadsPrec :: Int -> ReadS RejectInboundCrossClusterSearchConnection
Prelude.Read, Int -> RejectInboundCrossClusterSearchConnection -> ShowS
[RejectInboundCrossClusterSearchConnection] -> ShowS
RejectInboundCrossClusterSearchConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectInboundCrossClusterSearchConnection] -> ShowS
$cshowList :: [RejectInboundCrossClusterSearchConnection] -> ShowS
show :: RejectInboundCrossClusterSearchConnection -> String
$cshow :: RejectInboundCrossClusterSearchConnection -> String
showsPrec :: Int -> RejectInboundCrossClusterSearchConnection -> ShowS
$cshowsPrec :: Int -> RejectInboundCrossClusterSearchConnection -> ShowS
Prelude.Show, forall x.
Rep RejectInboundCrossClusterSearchConnection x
-> RejectInboundCrossClusterSearchConnection
forall x.
RejectInboundCrossClusterSearchConnection
-> Rep RejectInboundCrossClusterSearchConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RejectInboundCrossClusterSearchConnection x
-> RejectInboundCrossClusterSearchConnection
$cfrom :: forall x.
RejectInboundCrossClusterSearchConnection
-> Rep RejectInboundCrossClusterSearchConnection x
Prelude.Generic)

-- |
-- Create a value of 'RejectInboundCrossClusterSearchConnection' 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:
--
-- 'crossClusterSearchConnectionId', 'rejectInboundCrossClusterSearchConnection_crossClusterSearchConnectionId' - The id of the inbound connection that you want to reject.
newRejectInboundCrossClusterSearchConnection ::
  -- | 'crossClusterSearchConnectionId'
  Prelude.Text ->
  RejectInboundCrossClusterSearchConnection
newRejectInboundCrossClusterSearchConnection :: Text -> RejectInboundCrossClusterSearchConnection
newRejectInboundCrossClusterSearchConnection
  Text
pCrossClusterSearchConnectionId_ =
    RejectInboundCrossClusterSearchConnection'
      { $sel:crossClusterSearchConnectionId:RejectInboundCrossClusterSearchConnection' :: Text
crossClusterSearchConnectionId =
          Text
pCrossClusterSearchConnectionId_
      }

-- | The id of the inbound connection that you want to reject.
rejectInboundCrossClusterSearchConnection_crossClusterSearchConnectionId :: Lens.Lens' RejectInboundCrossClusterSearchConnection Prelude.Text
rejectInboundCrossClusterSearchConnection_crossClusterSearchConnectionId :: Lens' RejectInboundCrossClusterSearchConnection Text
rejectInboundCrossClusterSearchConnection_crossClusterSearchConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectInboundCrossClusterSearchConnection' {Text
crossClusterSearchConnectionId :: Text
$sel:crossClusterSearchConnectionId:RejectInboundCrossClusterSearchConnection' :: RejectInboundCrossClusterSearchConnection -> Text
crossClusterSearchConnectionId} -> Text
crossClusterSearchConnectionId) (\s :: RejectInboundCrossClusterSearchConnection
s@RejectInboundCrossClusterSearchConnection' {} Text
a -> RejectInboundCrossClusterSearchConnection
s {$sel:crossClusterSearchConnectionId:RejectInboundCrossClusterSearchConnection' :: Text
crossClusterSearchConnectionId = Text
a} :: RejectInboundCrossClusterSearchConnection)

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

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

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

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

instance
  Data.ToPath
    RejectInboundCrossClusterSearchConnection
  where
  toPath :: RejectInboundCrossClusterSearchConnection -> ByteString
toPath RejectInboundCrossClusterSearchConnection' {Text
crossClusterSearchConnectionId :: Text
$sel:crossClusterSearchConnectionId:RejectInboundCrossClusterSearchConnection' :: RejectInboundCrossClusterSearchConnection -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-01-01/es/ccs/inboundConnection/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
crossClusterSearchConnectionId,
        ByteString
"/reject"
      ]

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

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

-- |
-- Create a value of 'RejectInboundCrossClusterSearchConnectionResponse' 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:
--
-- 'crossClusterSearchConnection', 'rejectInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection' - Specifies the @InboundCrossClusterSearchConnection@ of rejected inbound
-- connection.
--
-- 'httpStatus', 'rejectInboundCrossClusterSearchConnectionResponse_httpStatus' - The response's http status code.
newRejectInboundCrossClusterSearchConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RejectInboundCrossClusterSearchConnectionResponse
newRejectInboundCrossClusterSearchConnectionResponse :: Int -> RejectInboundCrossClusterSearchConnectionResponse
newRejectInboundCrossClusterSearchConnectionResponse
  Int
pHttpStatus_ =
    RejectInboundCrossClusterSearchConnectionResponse'
      { $sel:crossClusterSearchConnection:RejectInboundCrossClusterSearchConnectionResponse' :: Maybe InboundCrossClusterSearchConnection
crossClusterSearchConnection =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:RejectInboundCrossClusterSearchConnectionResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | Specifies the @InboundCrossClusterSearchConnection@ of rejected inbound
-- connection.
rejectInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection :: Lens.Lens' RejectInboundCrossClusterSearchConnectionResponse (Prelude.Maybe InboundCrossClusterSearchConnection)
rejectInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection :: Lens'
  RejectInboundCrossClusterSearchConnectionResponse
  (Maybe InboundCrossClusterSearchConnection)
rejectInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectInboundCrossClusterSearchConnectionResponse' {Maybe InboundCrossClusterSearchConnection
crossClusterSearchConnection :: Maybe InboundCrossClusterSearchConnection
$sel:crossClusterSearchConnection:RejectInboundCrossClusterSearchConnectionResponse' :: RejectInboundCrossClusterSearchConnectionResponse
-> Maybe InboundCrossClusterSearchConnection
crossClusterSearchConnection} -> Maybe InboundCrossClusterSearchConnection
crossClusterSearchConnection) (\s :: RejectInboundCrossClusterSearchConnectionResponse
s@RejectInboundCrossClusterSearchConnectionResponse' {} Maybe InboundCrossClusterSearchConnection
a -> RejectInboundCrossClusterSearchConnectionResponse
s {$sel:crossClusterSearchConnection:RejectInboundCrossClusterSearchConnectionResponse' :: Maybe InboundCrossClusterSearchConnection
crossClusterSearchConnection = Maybe InboundCrossClusterSearchConnection
a} :: RejectInboundCrossClusterSearchConnectionResponse)

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

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