{-# 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.WellArchitected.DeleteWorkload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete an existing workload.
module Amazonka.WellArchitected.DeleteWorkload
  ( -- * Creating a Request
    DeleteWorkload (..),
    newDeleteWorkload,

    -- * Request Lenses
    deleteWorkload_workloadId,
    deleteWorkload_clientRequestToken,

    -- * Destructuring the Response
    DeleteWorkloadResponse (..),
    newDeleteWorkloadResponse,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WellArchitected.Types

-- | Input for workload deletion.
--
-- /See:/ 'newDeleteWorkload' smart constructor.
data DeleteWorkload = DeleteWorkload'
  { DeleteWorkload -> Text
workloadId :: Prelude.Text,
    DeleteWorkload -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (DeleteWorkload -> DeleteWorkload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWorkload -> DeleteWorkload -> Bool
$c/= :: DeleteWorkload -> DeleteWorkload -> Bool
== :: DeleteWorkload -> DeleteWorkload -> Bool
$c== :: DeleteWorkload -> DeleteWorkload -> Bool
Prelude.Eq, ReadPrec [DeleteWorkload]
ReadPrec DeleteWorkload
Int -> ReadS DeleteWorkload
ReadS [DeleteWorkload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteWorkload]
$creadListPrec :: ReadPrec [DeleteWorkload]
readPrec :: ReadPrec DeleteWorkload
$creadPrec :: ReadPrec DeleteWorkload
readList :: ReadS [DeleteWorkload]
$creadList :: ReadS [DeleteWorkload]
readsPrec :: Int -> ReadS DeleteWorkload
$creadsPrec :: Int -> ReadS DeleteWorkload
Prelude.Read, Int -> DeleteWorkload -> ShowS
[DeleteWorkload] -> ShowS
DeleteWorkload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWorkload] -> ShowS
$cshowList :: [DeleteWorkload] -> ShowS
show :: DeleteWorkload -> String
$cshow :: DeleteWorkload -> String
showsPrec :: Int -> DeleteWorkload -> ShowS
$cshowsPrec :: Int -> DeleteWorkload -> ShowS
Prelude.Show, forall x. Rep DeleteWorkload x -> DeleteWorkload
forall x. DeleteWorkload -> Rep DeleteWorkload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteWorkload x -> DeleteWorkload
$cfrom :: forall x. DeleteWorkload -> Rep DeleteWorkload x
Prelude.Generic)

-- |
-- Create a value of 'DeleteWorkload' 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:
--
-- 'workloadId', 'deleteWorkload_workloadId' - Undocumented member.
--
-- 'clientRequestToken', 'deleteWorkload_clientRequestToken' - Undocumented member.
newDeleteWorkload ::
  -- | 'workloadId'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  DeleteWorkload
newDeleteWorkload :: Text -> Text -> DeleteWorkload
newDeleteWorkload Text
pWorkloadId_ Text
pClientRequestToken_ =
  DeleteWorkload'
    { $sel:workloadId:DeleteWorkload' :: Text
workloadId = Text
pWorkloadId_,
      $sel:clientRequestToken:DeleteWorkload' :: Text
clientRequestToken = Text
pClientRequestToken_
    }

-- | Undocumented member.
deleteWorkload_workloadId :: Lens.Lens' DeleteWorkload Prelude.Text
deleteWorkload_workloadId :: Lens' DeleteWorkload Text
deleteWorkload_workloadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkload' {Text
workloadId :: Text
$sel:workloadId:DeleteWorkload' :: DeleteWorkload -> Text
workloadId} -> Text
workloadId) (\s :: DeleteWorkload
s@DeleteWorkload' {} Text
a -> DeleteWorkload
s {$sel:workloadId:DeleteWorkload' :: Text
workloadId = Text
a} :: DeleteWorkload)

-- | Undocumented member.
deleteWorkload_clientRequestToken :: Lens.Lens' DeleteWorkload Prelude.Text
deleteWorkload_clientRequestToken :: Lens' DeleteWorkload Text
deleteWorkload_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkload' {Text
clientRequestToken :: Text
$sel:clientRequestToken:DeleteWorkload' :: DeleteWorkload -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: DeleteWorkload
s@DeleteWorkload' {} Text
a -> DeleteWorkload
s {$sel:clientRequestToken:DeleteWorkload' :: Text
clientRequestToken = Text
a} :: DeleteWorkload)

instance Core.AWSRequest DeleteWorkload where
  type
    AWSResponse DeleteWorkload =
      DeleteWorkloadResponse
  request :: (Service -> Service) -> DeleteWorkload -> Request DeleteWorkload
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 DeleteWorkload
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteWorkload)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteWorkloadResponse
DeleteWorkloadResponse'

instance Prelude.Hashable DeleteWorkload where
  hashWithSalt :: Int -> DeleteWorkload -> Int
hashWithSalt Int
_salt DeleteWorkload' {Text
clientRequestToken :: Text
workloadId :: Text
$sel:clientRequestToken:DeleteWorkload' :: DeleteWorkload -> Text
$sel:workloadId:DeleteWorkload' :: DeleteWorkload -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData DeleteWorkload where
  rnf :: DeleteWorkload -> ()
rnf DeleteWorkload' {Text
clientRequestToken :: Text
workloadId :: Text
$sel:clientRequestToken:DeleteWorkload' :: DeleteWorkload -> Text
$sel:workloadId:DeleteWorkload' :: DeleteWorkload -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workloadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

instance Data.ToHeaders DeleteWorkload where
  toHeaders :: DeleteWorkload -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteWorkload where
  toPath :: DeleteWorkload -> ByteString
toPath DeleteWorkload' {Text
clientRequestToken :: Text
workloadId :: Text
$sel:clientRequestToken:DeleteWorkload' :: DeleteWorkload -> Text
$sel:workloadId:DeleteWorkload' :: DeleteWorkload -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/workloads/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
workloadId]

instance Data.ToQuery DeleteWorkload where
  toQuery :: DeleteWorkload -> QueryString
toQuery DeleteWorkload' {Text
clientRequestToken :: Text
workloadId :: Text
$sel:clientRequestToken:DeleteWorkload' :: DeleteWorkload -> Text
$sel:workloadId:DeleteWorkload' :: DeleteWorkload -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"ClientRequestToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientRequestToken]

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

-- |
-- Create a value of 'DeleteWorkloadResponse' 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.
newDeleteWorkloadResponse ::
  DeleteWorkloadResponse
newDeleteWorkloadResponse :: DeleteWorkloadResponse
newDeleteWorkloadResponse = DeleteWorkloadResponse
DeleteWorkloadResponse'

instance Prelude.NFData DeleteWorkloadResponse where
  rnf :: DeleteWorkloadResponse -> ()
rnf DeleteWorkloadResponse
_ = ()