{-# 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.Grafana.DeleteWorkspaceApiKey
-- 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 Grafana API key for the workspace.
module Amazonka.Grafana.DeleteWorkspaceApiKey
  ( -- * Creating a Request
    DeleteWorkspaceApiKey (..),
    newDeleteWorkspaceApiKey,

    -- * Request Lenses
    deleteWorkspaceApiKey_keyName,
    deleteWorkspaceApiKey_workspaceId,

    -- * Destructuring the Response
    DeleteWorkspaceApiKeyResponse (..),
    newDeleteWorkspaceApiKeyResponse,

    -- * Response Lenses
    deleteWorkspaceApiKeyResponse_httpStatus,
    deleteWorkspaceApiKeyResponse_keyName,
    deleteWorkspaceApiKeyResponse_workspaceId,
  )
where

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

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

-- |
-- Create a value of 'DeleteWorkspaceApiKey' 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:
--
-- 'keyName', 'deleteWorkspaceApiKey_keyName' - The name of the API key to delete.
--
-- 'workspaceId', 'deleteWorkspaceApiKey_workspaceId' - The ID of the workspace to delete.
newDeleteWorkspaceApiKey ::
  -- | 'keyName'
  Prelude.Text ->
  -- | 'workspaceId'
  Prelude.Text ->
  DeleteWorkspaceApiKey
newDeleteWorkspaceApiKey :: Text -> Text -> DeleteWorkspaceApiKey
newDeleteWorkspaceApiKey Text
pKeyName_ Text
pWorkspaceId_ =
  DeleteWorkspaceApiKey'
    { $sel:keyName:DeleteWorkspaceApiKey' :: Text
keyName = Text
pKeyName_,
      $sel:workspaceId:DeleteWorkspaceApiKey' :: Text
workspaceId = Text
pWorkspaceId_
    }

-- | The name of the API key to delete.
deleteWorkspaceApiKey_keyName :: Lens.Lens' DeleteWorkspaceApiKey Prelude.Text
deleteWorkspaceApiKey_keyName :: Lens' DeleteWorkspaceApiKey Text
deleteWorkspaceApiKey_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkspaceApiKey' {Text
keyName :: Text
$sel:keyName:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
keyName} -> Text
keyName) (\s :: DeleteWorkspaceApiKey
s@DeleteWorkspaceApiKey' {} Text
a -> DeleteWorkspaceApiKey
s {$sel:keyName:DeleteWorkspaceApiKey' :: Text
keyName = Text
a} :: DeleteWorkspaceApiKey)

-- | The ID of the workspace to delete.
deleteWorkspaceApiKey_workspaceId :: Lens.Lens' DeleteWorkspaceApiKey Prelude.Text
deleteWorkspaceApiKey_workspaceId :: Lens' DeleteWorkspaceApiKey Text
deleteWorkspaceApiKey_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkspaceApiKey' {Text
workspaceId :: Text
$sel:workspaceId:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
workspaceId} -> Text
workspaceId) (\s :: DeleteWorkspaceApiKey
s@DeleteWorkspaceApiKey' {} Text
a -> DeleteWorkspaceApiKey
s {$sel:workspaceId:DeleteWorkspaceApiKey' :: Text
workspaceId = Text
a} :: DeleteWorkspaceApiKey)

instance Core.AWSRequest DeleteWorkspaceApiKey where
  type
    AWSResponse DeleteWorkspaceApiKey =
      DeleteWorkspaceApiKeyResponse
  request :: (Service -> Service)
-> DeleteWorkspaceApiKey -> Request DeleteWorkspaceApiKey
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 DeleteWorkspaceApiKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteWorkspaceApiKey)))
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 ->
          Int -> Text -> Text -> DeleteWorkspaceApiKeyResponse
DeleteWorkspaceApiKeyResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"keyName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"workspaceId")
      )

instance Prelude.Hashable DeleteWorkspaceApiKey where
  hashWithSalt :: Int -> DeleteWorkspaceApiKey -> Int
hashWithSalt Int
_salt DeleteWorkspaceApiKey' {Text
workspaceId :: Text
keyName :: Text
$sel:workspaceId:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
$sel:keyName:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId

instance Prelude.NFData DeleteWorkspaceApiKey where
  rnf :: DeleteWorkspaceApiKey -> ()
rnf DeleteWorkspaceApiKey' {Text
workspaceId :: Text
keyName :: Text
$sel:workspaceId:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
$sel:keyName:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId

instance Data.ToHeaders DeleteWorkspaceApiKey where
  toHeaders :: DeleteWorkspaceApiKey -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteWorkspaceApiKey where
  toPath :: DeleteWorkspaceApiKey -> ByteString
toPath DeleteWorkspaceApiKey' {Text
workspaceId :: Text
keyName :: Text
$sel:workspaceId:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
$sel:keyName:DeleteWorkspaceApiKey' :: DeleteWorkspaceApiKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/apikeys/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
keyName
      ]

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

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

-- |
-- Create a value of 'DeleteWorkspaceApiKeyResponse' 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', 'deleteWorkspaceApiKeyResponse_httpStatus' - The response's http status code.
--
-- 'keyName', 'deleteWorkspaceApiKeyResponse_keyName' - The name of the key that was deleted.
--
-- 'workspaceId', 'deleteWorkspaceApiKeyResponse_workspaceId' - The ID of the workspace where the key was deleted.
newDeleteWorkspaceApiKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'keyName'
  Prelude.Text ->
  -- | 'workspaceId'
  Prelude.Text ->
  DeleteWorkspaceApiKeyResponse
newDeleteWorkspaceApiKeyResponse :: Int -> Text -> Text -> DeleteWorkspaceApiKeyResponse
newDeleteWorkspaceApiKeyResponse
  Int
pHttpStatus_
  Text
pKeyName_
  Text
pWorkspaceId_ =
    DeleteWorkspaceApiKeyResponse'
      { $sel:httpStatus:DeleteWorkspaceApiKeyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:keyName:DeleteWorkspaceApiKeyResponse' :: Text
keyName = Text
pKeyName_,
        $sel:workspaceId:DeleteWorkspaceApiKeyResponse' :: Text
workspaceId = Text
pWorkspaceId_
      }

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

-- | The name of the key that was deleted.
deleteWorkspaceApiKeyResponse_keyName :: Lens.Lens' DeleteWorkspaceApiKeyResponse Prelude.Text
deleteWorkspaceApiKeyResponse_keyName :: Lens' DeleteWorkspaceApiKeyResponse Text
deleteWorkspaceApiKeyResponse_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkspaceApiKeyResponse' {Text
keyName :: Text
$sel:keyName:DeleteWorkspaceApiKeyResponse' :: DeleteWorkspaceApiKeyResponse -> Text
keyName} -> Text
keyName) (\s :: DeleteWorkspaceApiKeyResponse
s@DeleteWorkspaceApiKeyResponse' {} Text
a -> DeleteWorkspaceApiKeyResponse
s {$sel:keyName:DeleteWorkspaceApiKeyResponse' :: Text
keyName = Text
a} :: DeleteWorkspaceApiKeyResponse)

-- | The ID of the workspace where the key was deleted.
deleteWorkspaceApiKeyResponse_workspaceId :: Lens.Lens' DeleteWorkspaceApiKeyResponse Prelude.Text
deleteWorkspaceApiKeyResponse_workspaceId :: Lens' DeleteWorkspaceApiKeyResponse Text
deleteWorkspaceApiKeyResponse_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkspaceApiKeyResponse' {Text
workspaceId :: Text
$sel:workspaceId:DeleteWorkspaceApiKeyResponse' :: DeleteWorkspaceApiKeyResponse -> Text
workspaceId} -> Text
workspaceId) (\s :: DeleteWorkspaceApiKeyResponse
s@DeleteWorkspaceApiKeyResponse' {} Text
a -> DeleteWorkspaceApiKeyResponse
s {$sel:workspaceId:DeleteWorkspaceApiKeyResponse' :: Text
workspaceId = Text
a} :: DeleteWorkspaceApiKeyResponse)

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