{-# 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.DeleteInboundCrossClusterSearchConnection
-- 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 delete an existing inbound
-- cross-cluster search connection.
module Amazonka.ElasticSearch.DeleteInboundCrossClusterSearchConnection
  ( -- * Creating a Request
    DeleteInboundCrossClusterSearchConnection (..),
    newDeleteInboundCrossClusterSearchConnection,

    -- * Request Lenses
    deleteInboundCrossClusterSearchConnection_crossClusterSearchConnectionId,

    -- * Destructuring the Response
    DeleteInboundCrossClusterSearchConnectionResponse (..),
    newDeleteInboundCrossClusterSearchConnectionResponse,

    -- * Response Lenses
    deleteInboundCrossClusterSearchConnectionResponse_crossClusterSearchConnection,
    deleteInboundCrossClusterSearchConnectionResponse_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
-- @DeleteInboundCrossClusterSearchConnection@ operation.
--
-- /See:/ 'newDeleteInboundCrossClusterSearchConnection' smart constructor.
data DeleteInboundCrossClusterSearchConnection = DeleteInboundCrossClusterSearchConnection'
  { -- | The id of the inbound connection that you want to permanently delete.
    DeleteInboundCrossClusterSearchConnection -> Text
crossClusterSearchConnectionId :: Prelude.Text
  }
  deriving (DeleteInboundCrossClusterSearchConnection
-> DeleteInboundCrossClusterSearchConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInboundCrossClusterSearchConnection
-> DeleteInboundCrossClusterSearchConnection -> Bool
$c/= :: DeleteInboundCrossClusterSearchConnection
-> DeleteInboundCrossClusterSearchConnection -> Bool
== :: DeleteInboundCrossClusterSearchConnection
-> DeleteInboundCrossClusterSearchConnection -> Bool
$c== :: DeleteInboundCrossClusterSearchConnection
-> DeleteInboundCrossClusterSearchConnection -> Bool
Prelude.Eq, ReadPrec [DeleteInboundCrossClusterSearchConnection]
ReadPrec DeleteInboundCrossClusterSearchConnection
Int -> ReadS DeleteInboundCrossClusterSearchConnection
ReadS [DeleteInboundCrossClusterSearchConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInboundCrossClusterSearchConnection]
$creadListPrec :: ReadPrec [DeleteInboundCrossClusterSearchConnection]
readPrec :: ReadPrec DeleteInboundCrossClusterSearchConnection
$creadPrec :: ReadPrec DeleteInboundCrossClusterSearchConnection
readList :: ReadS [DeleteInboundCrossClusterSearchConnection]
$creadList :: ReadS [DeleteInboundCrossClusterSearchConnection]
readsPrec :: Int -> ReadS DeleteInboundCrossClusterSearchConnection
$creadsPrec :: Int -> ReadS DeleteInboundCrossClusterSearchConnection
Prelude.Read, Int -> DeleteInboundCrossClusterSearchConnection -> ShowS
[DeleteInboundCrossClusterSearchConnection] -> ShowS
DeleteInboundCrossClusterSearchConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInboundCrossClusterSearchConnection] -> ShowS
$cshowList :: [DeleteInboundCrossClusterSearchConnection] -> ShowS
show :: DeleteInboundCrossClusterSearchConnection -> String
$cshow :: DeleteInboundCrossClusterSearchConnection -> String
showsPrec :: Int -> DeleteInboundCrossClusterSearchConnection -> ShowS
$cshowsPrec :: Int -> DeleteInboundCrossClusterSearchConnection -> ShowS
Prelude.Show, forall x.
Rep DeleteInboundCrossClusterSearchConnection x
-> DeleteInboundCrossClusterSearchConnection
forall x.
DeleteInboundCrossClusterSearchConnection
-> Rep DeleteInboundCrossClusterSearchConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteInboundCrossClusterSearchConnection x
-> DeleteInboundCrossClusterSearchConnection
$cfrom :: forall x.
DeleteInboundCrossClusterSearchConnection
-> Rep DeleteInboundCrossClusterSearchConnection x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInboundCrossClusterSearchConnection' 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', 'deleteInboundCrossClusterSearchConnection_crossClusterSearchConnectionId' - The id of the inbound connection that you want to permanently delete.
newDeleteInboundCrossClusterSearchConnection ::
  -- | 'crossClusterSearchConnectionId'
  Prelude.Text ->
  DeleteInboundCrossClusterSearchConnection
newDeleteInboundCrossClusterSearchConnection :: Text -> DeleteInboundCrossClusterSearchConnection
newDeleteInboundCrossClusterSearchConnection
  Text
pCrossClusterSearchConnectionId_ =
    DeleteInboundCrossClusterSearchConnection'
      { $sel:crossClusterSearchConnectionId:DeleteInboundCrossClusterSearchConnection' :: Text
crossClusterSearchConnectionId =
          Text
pCrossClusterSearchConnectionId_
      }

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

instance
  Core.AWSRequest
    DeleteInboundCrossClusterSearchConnection
  where
  type
    AWSResponse
      DeleteInboundCrossClusterSearchConnection =
      DeleteInboundCrossClusterSearchConnectionResponse
  request :: (Service -> Service)
-> DeleteInboundCrossClusterSearchConnection
-> Request DeleteInboundCrossClusterSearchConnection
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteInboundCrossClusterSearchConnection
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DeleteInboundCrossClusterSearchConnection)))
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 -> DeleteInboundCrossClusterSearchConnectionResponse
DeleteInboundCrossClusterSearchConnectionResponse'
            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
    DeleteInboundCrossClusterSearchConnection
  where
  hashWithSalt :: Int -> DeleteInboundCrossClusterSearchConnection -> Int
hashWithSalt
    Int
_salt
    DeleteInboundCrossClusterSearchConnection' {Text
crossClusterSearchConnectionId :: Text
$sel:crossClusterSearchConnectionId:DeleteInboundCrossClusterSearchConnection' :: DeleteInboundCrossClusterSearchConnection -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
crossClusterSearchConnectionId

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

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

instance
  Data.ToPath
    DeleteInboundCrossClusterSearchConnection
  where
  toPath :: DeleteInboundCrossClusterSearchConnection -> ByteString
toPath DeleteInboundCrossClusterSearchConnection' {Text
crossClusterSearchConnectionId :: Text
$sel:crossClusterSearchConnectionId:DeleteInboundCrossClusterSearchConnection' :: DeleteInboundCrossClusterSearchConnection -> 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
      ]

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

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

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

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

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

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