{-# 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.Redshift.DeleteAuthenticationProfile
-- 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 an authentication profile.
module Amazonka.Redshift.DeleteAuthenticationProfile
  ( -- * Creating a Request
    DeleteAuthenticationProfile (..),
    newDeleteAuthenticationProfile,

    -- * Request Lenses
    deleteAuthenticationProfile_authenticationProfileName,

    -- * Destructuring the Response
    DeleteAuthenticationProfileResponse (..),
    newDeleteAuthenticationProfileResponse,

    -- * Response Lenses
    deleteAuthenticationProfileResponse_authenticationProfileName,
    deleteAuthenticationProfileResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteAuthenticationProfile' smart constructor.
data DeleteAuthenticationProfile = DeleteAuthenticationProfile'
  { -- | The name of the authentication profile to delete.
    DeleteAuthenticationProfile -> Text
authenticationProfileName :: Prelude.Text
  }
  deriving (DeleteAuthenticationProfile -> DeleteAuthenticationProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAuthenticationProfile -> DeleteAuthenticationProfile -> Bool
$c/= :: DeleteAuthenticationProfile -> DeleteAuthenticationProfile -> Bool
== :: DeleteAuthenticationProfile -> DeleteAuthenticationProfile -> Bool
$c== :: DeleteAuthenticationProfile -> DeleteAuthenticationProfile -> Bool
Prelude.Eq, ReadPrec [DeleteAuthenticationProfile]
ReadPrec DeleteAuthenticationProfile
Int -> ReadS DeleteAuthenticationProfile
ReadS [DeleteAuthenticationProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAuthenticationProfile]
$creadListPrec :: ReadPrec [DeleteAuthenticationProfile]
readPrec :: ReadPrec DeleteAuthenticationProfile
$creadPrec :: ReadPrec DeleteAuthenticationProfile
readList :: ReadS [DeleteAuthenticationProfile]
$creadList :: ReadS [DeleteAuthenticationProfile]
readsPrec :: Int -> ReadS DeleteAuthenticationProfile
$creadsPrec :: Int -> ReadS DeleteAuthenticationProfile
Prelude.Read, Int -> DeleteAuthenticationProfile -> ShowS
[DeleteAuthenticationProfile] -> ShowS
DeleteAuthenticationProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAuthenticationProfile] -> ShowS
$cshowList :: [DeleteAuthenticationProfile] -> ShowS
show :: DeleteAuthenticationProfile -> String
$cshow :: DeleteAuthenticationProfile -> String
showsPrec :: Int -> DeleteAuthenticationProfile -> ShowS
$cshowsPrec :: Int -> DeleteAuthenticationProfile -> ShowS
Prelude.Show, forall x.
Rep DeleteAuthenticationProfile x -> DeleteAuthenticationProfile
forall x.
DeleteAuthenticationProfile -> Rep DeleteAuthenticationProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteAuthenticationProfile x -> DeleteAuthenticationProfile
$cfrom :: forall x.
DeleteAuthenticationProfile -> Rep DeleteAuthenticationProfile x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAuthenticationProfile' 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:
--
-- 'authenticationProfileName', 'deleteAuthenticationProfile_authenticationProfileName' - The name of the authentication profile to delete.
newDeleteAuthenticationProfile ::
  -- | 'authenticationProfileName'
  Prelude.Text ->
  DeleteAuthenticationProfile
newDeleteAuthenticationProfile :: Text -> DeleteAuthenticationProfile
newDeleteAuthenticationProfile
  Text
pAuthenticationProfileName_ =
    DeleteAuthenticationProfile'
      { $sel:authenticationProfileName:DeleteAuthenticationProfile' :: Text
authenticationProfileName =
          Text
pAuthenticationProfileName_
      }

-- | The name of the authentication profile to delete.
deleteAuthenticationProfile_authenticationProfileName :: Lens.Lens' DeleteAuthenticationProfile Prelude.Text
deleteAuthenticationProfile_authenticationProfileName :: Lens' DeleteAuthenticationProfile Text
deleteAuthenticationProfile_authenticationProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAuthenticationProfile' {Text
authenticationProfileName :: Text
$sel:authenticationProfileName:DeleteAuthenticationProfile' :: DeleteAuthenticationProfile -> Text
authenticationProfileName} -> Text
authenticationProfileName) (\s :: DeleteAuthenticationProfile
s@DeleteAuthenticationProfile' {} Text
a -> DeleteAuthenticationProfile
s {$sel:authenticationProfileName:DeleteAuthenticationProfile' :: Text
authenticationProfileName = Text
a} :: DeleteAuthenticationProfile)

instance Core.AWSRequest DeleteAuthenticationProfile where
  type
    AWSResponse DeleteAuthenticationProfile =
      DeleteAuthenticationProfileResponse
  request :: (Service -> Service)
-> DeleteAuthenticationProfile
-> Request DeleteAuthenticationProfile
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteAuthenticationProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteAuthenticationProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DeleteAuthenticationProfileResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> DeleteAuthenticationProfileResponse
DeleteAuthenticationProfileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AuthenticationProfileName")
            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 DeleteAuthenticationProfile where
  hashWithSalt :: Int -> DeleteAuthenticationProfile -> Int
hashWithSalt Int
_salt DeleteAuthenticationProfile' {Text
authenticationProfileName :: Text
$sel:authenticationProfileName:DeleteAuthenticationProfile' :: DeleteAuthenticationProfile -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
authenticationProfileName

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

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

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

instance Data.ToQuery DeleteAuthenticationProfile where
  toQuery :: DeleteAuthenticationProfile -> QueryString
toQuery DeleteAuthenticationProfile' {Text
authenticationProfileName :: Text
$sel:authenticationProfileName:DeleteAuthenticationProfile' :: DeleteAuthenticationProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DeleteAuthenticationProfile" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"AuthenticationProfileName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
authenticationProfileName
      ]

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

-- |
-- Create a value of 'DeleteAuthenticationProfileResponse' 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:
--
-- 'authenticationProfileName', 'deleteAuthenticationProfileResponse_authenticationProfileName' - The name of the authentication profile that was deleted.
--
-- 'httpStatus', 'deleteAuthenticationProfileResponse_httpStatus' - The response's http status code.
newDeleteAuthenticationProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteAuthenticationProfileResponse
newDeleteAuthenticationProfileResponse :: Int -> DeleteAuthenticationProfileResponse
newDeleteAuthenticationProfileResponse Int
pHttpStatus_ =
  DeleteAuthenticationProfileResponse'
    { $sel:authenticationProfileName:DeleteAuthenticationProfileResponse' :: Maybe Text
authenticationProfileName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteAuthenticationProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the authentication profile that was deleted.
deleteAuthenticationProfileResponse_authenticationProfileName :: Lens.Lens' DeleteAuthenticationProfileResponse (Prelude.Maybe Prelude.Text)
deleteAuthenticationProfileResponse_authenticationProfileName :: Lens' DeleteAuthenticationProfileResponse (Maybe Text)
deleteAuthenticationProfileResponse_authenticationProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAuthenticationProfileResponse' {Maybe Text
authenticationProfileName :: Maybe Text
$sel:authenticationProfileName:DeleteAuthenticationProfileResponse' :: DeleteAuthenticationProfileResponse -> Maybe Text
authenticationProfileName} -> Maybe Text
authenticationProfileName) (\s :: DeleteAuthenticationProfileResponse
s@DeleteAuthenticationProfileResponse' {} Maybe Text
a -> DeleteAuthenticationProfileResponse
s {$sel:authenticationProfileName:DeleteAuthenticationProfileResponse' :: Maybe Text
authenticationProfileName = Maybe Text
a} :: DeleteAuthenticationProfileResponse)

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

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