{-# 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.EC2.DeleteSpotDatafeedSubscription
-- 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 the data feed for Spot Instances.
module Amazonka.EC2.DeleteSpotDatafeedSubscription
  ( -- * Creating a Request
    DeleteSpotDatafeedSubscription (..),
    newDeleteSpotDatafeedSubscription,

    -- * Request Lenses
    deleteSpotDatafeedSubscription_dryRun,

    -- * Destructuring the Response
    DeleteSpotDatafeedSubscriptionResponse (..),
    newDeleteSpotDatafeedSubscriptionResponse,
  )
where

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

-- | Contains the parameters for DeleteSpotDatafeedSubscription.
--
-- /See:/ 'newDeleteSpotDatafeedSubscription' smart constructor.
data DeleteSpotDatafeedSubscription = DeleteSpotDatafeedSubscription'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DeleteSpotDatafeedSubscription -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool
  }
  deriving (DeleteSpotDatafeedSubscription
-> DeleteSpotDatafeedSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSpotDatafeedSubscription
-> DeleteSpotDatafeedSubscription -> Bool
$c/= :: DeleteSpotDatafeedSubscription
-> DeleteSpotDatafeedSubscription -> Bool
== :: DeleteSpotDatafeedSubscription
-> DeleteSpotDatafeedSubscription -> Bool
$c== :: DeleteSpotDatafeedSubscription
-> DeleteSpotDatafeedSubscription -> Bool
Prelude.Eq, ReadPrec [DeleteSpotDatafeedSubscription]
ReadPrec DeleteSpotDatafeedSubscription
Int -> ReadS DeleteSpotDatafeedSubscription
ReadS [DeleteSpotDatafeedSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSpotDatafeedSubscription]
$creadListPrec :: ReadPrec [DeleteSpotDatafeedSubscription]
readPrec :: ReadPrec DeleteSpotDatafeedSubscription
$creadPrec :: ReadPrec DeleteSpotDatafeedSubscription
readList :: ReadS [DeleteSpotDatafeedSubscription]
$creadList :: ReadS [DeleteSpotDatafeedSubscription]
readsPrec :: Int -> ReadS DeleteSpotDatafeedSubscription
$creadsPrec :: Int -> ReadS DeleteSpotDatafeedSubscription
Prelude.Read, Int -> DeleteSpotDatafeedSubscription -> ShowS
[DeleteSpotDatafeedSubscription] -> ShowS
DeleteSpotDatafeedSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSpotDatafeedSubscription] -> ShowS
$cshowList :: [DeleteSpotDatafeedSubscription] -> ShowS
show :: DeleteSpotDatafeedSubscription -> String
$cshow :: DeleteSpotDatafeedSubscription -> String
showsPrec :: Int -> DeleteSpotDatafeedSubscription -> ShowS
$cshowsPrec :: Int -> DeleteSpotDatafeedSubscription -> ShowS
Prelude.Show, forall x.
Rep DeleteSpotDatafeedSubscription x
-> DeleteSpotDatafeedSubscription
forall x.
DeleteSpotDatafeedSubscription
-> Rep DeleteSpotDatafeedSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSpotDatafeedSubscription x
-> DeleteSpotDatafeedSubscription
$cfrom :: forall x.
DeleteSpotDatafeedSubscription
-> Rep DeleteSpotDatafeedSubscription x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSpotDatafeedSubscription' 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:
--
-- 'dryRun', 'deleteSpotDatafeedSubscription_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
newDeleteSpotDatafeedSubscription ::
  DeleteSpotDatafeedSubscription
newDeleteSpotDatafeedSubscription :: DeleteSpotDatafeedSubscription
newDeleteSpotDatafeedSubscription =
  DeleteSpotDatafeedSubscription'
    { $sel:dryRun:DeleteSpotDatafeedSubscription' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
deleteSpotDatafeedSubscription_dryRun :: Lens.Lens' DeleteSpotDatafeedSubscription (Prelude.Maybe Prelude.Bool)
deleteSpotDatafeedSubscription_dryRun :: Lens' DeleteSpotDatafeedSubscription (Maybe Bool)
deleteSpotDatafeedSubscription_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSpotDatafeedSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteSpotDatafeedSubscription' :: DeleteSpotDatafeedSubscription -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DeleteSpotDatafeedSubscription
s@DeleteSpotDatafeedSubscription' {} Maybe Bool
a -> DeleteSpotDatafeedSubscription
s {$sel:dryRun:DeleteSpotDatafeedSubscription' :: Maybe Bool
dryRun = Maybe Bool
a} :: DeleteSpotDatafeedSubscription)

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

instance
  Prelude.Hashable
    DeleteSpotDatafeedSubscription
  where
  hashWithSalt :: Int -> DeleteSpotDatafeedSubscription -> Int
hashWithSalt
    Int
_salt
    DeleteSpotDatafeedSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteSpotDatafeedSubscription' :: DeleteSpotDatafeedSubscription -> Maybe Bool
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun

instance
  Prelude.NFData
    DeleteSpotDatafeedSubscription
  where
  rnf :: DeleteSpotDatafeedSubscription -> ()
rnf DeleteSpotDatafeedSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteSpotDatafeedSubscription' :: DeleteSpotDatafeedSubscription -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun

instance
  Data.ToHeaders
    DeleteSpotDatafeedSubscription
  where
  toHeaders :: DeleteSpotDatafeedSubscription -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteSpotDatafeedSubscription where
  toQuery :: DeleteSpotDatafeedSubscription -> QueryString
toQuery DeleteSpotDatafeedSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteSpotDatafeedSubscription' :: DeleteSpotDatafeedSubscription -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DeleteSpotDatafeedSubscription" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun
      ]

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

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

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