{-# 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.OpenSearchServerless.DeleteSecurityConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a security configuration for OpenSearch Serverless. For more
-- information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/serverless-saml.html SAML authentication for Amazon OpenSearch Serverless>.
module Amazonka.OpenSearchServerless.DeleteSecurityConfig
  ( -- * Creating a Request
    DeleteSecurityConfig (..),
    newDeleteSecurityConfig,

    -- * Request Lenses
    deleteSecurityConfig_clientToken,
    deleteSecurityConfig_id,

    -- * Destructuring the Response
    DeleteSecurityConfigResponse (..),
    newDeleteSecurityConfigResponse,

    -- * Response Lenses
    deleteSecurityConfigResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteSecurityConfig' smart constructor.
data DeleteSecurityConfig = DeleteSecurityConfig'
  { -- | Unique, case-sensitive identifier to ensure idempotency of the request.
    DeleteSecurityConfig -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The security configuration identifier. For SAML the ID will be
    -- @saml\/\<accountId>\/\<idpProviderName>@. For example,
    -- @saml\/123456789123\/OKTADev@.
    DeleteSecurityConfig -> Text
id :: Prelude.Text
  }
  deriving (DeleteSecurityConfig -> DeleteSecurityConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSecurityConfig -> DeleteSecurityConfig -> Bool
$c/= :: DeleteSecurityConfig -> DeleteSecurityConfig -> Bool
== :: DeleteSecurityConfig -> DeleteSecurityConfig -> Bool
$c== :: DeleteSecurityConfig -> DeleteSecurityConfig -> Bool
Prelude.Eq, ReadPrec [DeleteSecurityConfig]
ReadPrec DeleteSecurityConfig
Int -> ReadS DeleteSecurityConfig
ReadS [DeleteSecurityConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSecurityConfig]
$creadListPrec :: ReadPrec [DeleteSecurityConfig]
readPrec :: ReadPrec DeleteSecurityConfig
$creadPrec :: ReadPrec DeleteSecurityConfig
readList :: ReadS [DeleteSecurityConfig]
$creadList :: ReadS [DeleteSecurityConfig]
readsPrec :: Int -> ReadS DeleteSecurityConfig
$creadsPrec :: Int -> ReadS DeleteSecurityConfig
Prelude.Read, Int -> DeleteSecurityConfig -> ShowS
[DeleteSecurityConfig] -> ShowS
DeleteSecurityConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSecurityConfig] -> ShowS
$cshowList :: [DeleteSecurityConfig] -> ShowS
show :: DeleteSecurityConfig -> String
$cshow :: DeleteSecurityConfig -> String
showsPrec :: Int -> DeleteSecurityConfig -> ShowS
$cshowsPrec :: Int -> DeleteSecurityConfig -> ShowS
Prelude.Show, forall x. Rep DeleteSecurityConfig x -> DeleteSecurityConfig
forall x. DeleteSecurityConfig -> Rep DeleteSecurityConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteSecurityConfig x -> DeleteSecurityConfig
$cfrom :: forall x. DeleteSecurityConfig -> Rep DeleteSecurityConfig x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSecurityConfig' 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:
--
-- 'clientToken', 'deleteSecurityConfig_clientToken' - Unique, case-sensitive identifier to ensure idempotency of the request.
--
-- 'id', 'deleteSecurityConfig_id' - The security configuration identifier. For SAML the ID will be
-- @saml\/\<accountId>\/\<idpProviderName>@. For example,
-- @saml\/123456789123\/OKTADev@.
newDeleteSecurityConfig ::
  -- | 'id'
  Prelude.Text ->
  DeleteSecurityConfig
newDeleteSecurityConfig :: Text -> DeleteSecurityConfig
newDeleteSecurityConfig Text
pId_ =
  DeleteSecurityConfig'
    { $sel:clientToken:DeleteSecurityConfig' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:id:DeleteSecurityConfig' :: Text
id = Text
pId_
    }

-- | Unique, case-sensitive identifier to ensure idempotency of the request.
deleteSecurityConfig_clientToken :: Lens.Lens' DeleteSecurityConfig (Prelude.Maybe Prelude.Text)
deleteSecurityConfig_clientToken :: Lens' DeleteSecurityConfig (Maybe Text)
deleteSecurityConfig_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSecurityConfig' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:DeleteSecurityConfig' :: DeleteSecurityConfig -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: DeleteSecurityConfig
s@DeleteSecurityConfig' {} Maybe Text
a -> DeleteSecurityConfig
s {$sel:clientToken:DeleteSecurityConfig' :: Maybe Text
clientToken = Maybe Text
a} :: DeleteSecurityConfig)

-- | The security configuration identifier. For SAML the ID will be
-- @saml\/\<accountId>\/\<idpProviderName>@. For example,
-- @saml\/123456789123\/OKTADev@.
deleteSecurityConfig_id :: Lens.Lens' DeleteSecurityConfig Prelude.Text
deleteSecurityConfig_id :: Lens' DeleteSecurityConfig Text
deleteSecurityConfig_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSecurityConfig' {Text
id :: Text
$sel:id:DeleteSecurityConfig' :: DeleteSecurityConfig -> Text
id} -> Text
id) (\s :: DeleteSecurityConfig
s@DeleteSecurityConfig' {} Text
a -> DeleteSecurityConfig
s {$sel:id:DeleteSecurityConfig' :: Text
id = Text
a} :: DeleteSecurityConfig)

instance Core.AWSRequest DeleteSecurityConfig where
  type
    AWSResponse DeleteSecurityConfig =
      DeleteSecurityConfigResponse
  request :: (Service -> Service)
-> DeleteSecurityConfig -> Request DeleteSecurityConfig
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 DeleteSecurityConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteSecurityConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteSecurityConfigResponse
DeleteSecurityConfigResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteSecurityConfig where
  hashWithSalt :: Int -> DeleteSecurityConfig -> Int
hashWithSalt Int
_salt DeleteSecurityConfig' {Maybe Text
Text
id :: Text
clientToken :: Maybe Text
$sel:id:DeleteSecurityConfig' :: DeleteSecurityConfig -> Text
$sel:clientToken:DeleteSecurityConfig' :: DeleteSecurityConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData DeleteSecurityConfig where
  rnf :: DeleteSecurityConfig -> ()
rnf DeleteSecurityConfig' {Maybe Text
Text
id :: Text
clientToken :: Maybe Text
$sel:id:DeleteSecurityConfig' :: DeleteSecurityConfig -> Text
$sel:clientToken:DeleteSecurityConfig' :: DeleteSecurityConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders DeleteSecurityConfig where
  toHeaders :: DeleteSecurityConfig -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OpenSearchServerless.DeleteSecurityConfig" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteSecurityConfig where
  toJSON :: DeleteSecurityConfig -> Value
toJSON DeleteSecurityConfig' {Maybe Text
Text
id :: Text
clientToken :: Maybe Text
$sel:id:DeleteSecurityConfig' :: DeleteSecurityConfig -> Text
$sel:clientToken:DeleteSecurityConfig' :: DeleteSecurityConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

instance Data.ToPath DeleteSecurityConfig where
  toPath :: DeleteSecurityConfig -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DeleteSecurityConfigResponse' 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:
--
-- 'httpStatus', 'deleteSecurityConfigResponse_httpStatus' - The response's http status code.
newDeleteSecurityConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteSecurityConfigResponse
newDeleteSecurityConfigResponse :: Int -> DeleteSecurityConfigResponse
newDeleteSecurityConfigResponse Int
pHttpStatus_ =
  DeleteSecurityConfigResponse'
    { $sel:httpStatus:DeleteSecurityConfigResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData DeleteSecurityConfigResponse where
  rnf :: DeleteSecurityConfigResponse -> ()
rnf DeleteSecurityConfigResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteSecurityConfigResponse' :: DeleteSecurityConfigResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus