{-# 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.ResetImageAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets an attribute of an AMI to its default value.
module Amazonka.EC2.ResetImageAttribute
  ( -- * Creating a Request
    ResetImageAttribute (..),
    newResetImageAttribute,

    -- * Request Lenses
    resetImageAttribute_dryRun,
    resetImageAttribute_attribute,
    resetImageAttribute_imageId,

    -- * Destructuring the Response
    ResetImageAttributeResponse (..),
    newResetImageAttributeResponse,
  )
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 ResetImageAttribute.
--
-- /See:/ 'newResetImageAttribute' smart constructor.
data ResetImageAttribute = ResetImageAttribute'
  { -- | 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@.
    ResetImageAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The attribute to reset (currently you can only reset the launch
    -- permission attribute).
    ResetImageAttribute -> ResetImageAttributeName
attribute :: ResetImageAttributeName,
    -- | The ID of the AMI.
    ResetImageAttribute -> Text
imageId :: Prelude.Text
  }
  deriving (ResetImageAttribute -> ResetImageAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetImageAttribute -> ResetImageAttribute -> Bool
$c/= :: ResetImageAttribute -> ResetImageAttribute -> Bool
== :: ResetImageAttribute -> ResetImageAttribute -> Bool
$c== :: ResetImageAttribute -> ResetImageAttribute -> Bool
Prelude.Eq, ReadPrec [ResetImageAttribute]
ReadPrec ResetImageAttribute
Int -> ReadS ResetImageAttribute
ReadS [ResetImageAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetImageAttribute]
$creadListPrec :: ReadPrec [ResetImageAttribute]
readPrec :: ReadPrec ResetImageAttribute
$creadPrec :: ReadPrec ResetImageAttribute
readList :: ReadS [ResetImageAttribute]
$creadList :: ReadS [ResetImageAttribute]
readsPrec :: Int -> ReadS ResetImageAttribute
$creadsPrec :: Int -> ReadS ResetImageAttribute
Prelude.Read, Int -> ResetImageAttribute -> ShowS
[ResetImageAttribute] -> ShowS
ResetImageAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetImageAttribute] -> ShowS
$cshowList :: [ResetImageAttribute] -> ShowS
show :: ResetImageAttribute -> String
$cshow :: ResetImageAttribute -> String
showsPrec :: Int -> ResetImageAttribute -> ShowS
$cshowsPrec :: Int -> ResetImageAttribute -> ShowS
Prelude.Show, forall x. Rep ResetImageAttribute x -> ResetImageAttribute
forall x. ResetImageAttribute -> Rep ResetImageAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetImageAttribute x -> ResetImageAttribute
$cfrom :: forall x. ResetImageAttribute -> Rep ResetImageAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ResetImageAttribute' 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', 'resetImageAttribute_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@.
--
-- 'attribute', 'resetImageAttribute_attribute' - The attribute to reset (currently you can only reset the launch
-- permission attribute).
--
-- 'imageId', 'resetImageAttribute_imageId' - The ID of the AMI.
newResetImageAttribute ::
  -- | 'attribute'
  ResetImageAttributeName ->
  -- | 'imageId'
  Prelude.Text ->
  ResetImageAttribute
newResetImageAttribute :: ResetImageAttributeName -> Text -> ResetImageAttribute
newResetImageAttribute ResetImageAttributeName
pAttribute_ Text
pImageId_ =
  ResetImageAttribute'
    { $sel:dryRun:ResetImageAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:attribute:ResetImageAttribute' :: ResetImageAttributeName
attribute = ResetImageAttributeName
pAttribute_,
      $sel:imageId:ResetImageAttribute' :: Text
imageId = Text
pImageId_
    }

-- | 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@.
resetImageAttribute_dryRun :: Lens.Lens' ResetImageAttribute (Prelude.Maybe Prelude.Bool)
resetImageAttribute_dryRun :: Lens' ResetImageAttribute (Maybe Bool)
resetImageAttribute_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetImageAttribute' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ResetImageAttribute' :: ResetImageAttribute -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ResetImageAttribute
s@ResetImageAttribute' {} Maybe Bool
a -> ResetImageAttribute
s {$sel:dryRun:ResetImageAttribute' :: Maybe Bool
dryRun = Maybe Bool
a} :: ResetImageAttribute)

-- | The attribute to reset (currently you can only reset the launch
-- permission attribute).
resetImageAttribute_attribute :: Lens.Lens' ResetImageAttribute ResetImageAttributeName
resetImageAttribute_attribute :: Lens' ResetImageAttribute ResetImageAttributeName
resetImageAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetImageAttribute' {ResetImageAttributeName
attribute :: ResetImageAttributeName
$sel:attribute:ResetImageAttribute' :: ResetImageAttribute -> ResetImageAttributeName
attribute} -> ResetImageAttributeName
attribute) (\s :: ResetImageAttribute
s@ResetImageAttribute' {} ResetImageAttributeName
a -> ResetImageAttribute
s {$sel:attribute:ResetImageAttribute' :: ResetImageAttributeName
attribute = ResetImageAttributeName
a} :: ResetImageAttribute)

-- | The ID of the AMI.
resetImageAttribute_imageId :: Lens.Lens' ResetImageAttribute Prelude.Text
resetImageAttribute_imageId :: Lens' ResetImageAttribute Text
resetImageAttribute_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetImageAttribute' {Text
imageId :: Text
$sel:imageId:ResetImageAttribute' :: ResetImageAttribute -> Text
imageId} -> Text
imageId) (\s :: ResetImageAttribute
s@ResetImageAttribute' {} Text
a -> ResetImageAttribute
s {$sel:imageId:ResetImageAttribute' :: Text
imageId = Text
a} :: ResetImageAttribute)

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

instance Prelude.Hashable ResetImageAttribute where
  hashWithSalt :: Int -> ResetImageAttribute -> Int
hashWithSalt Int
_salt ResetImageAttribute' {Maybe Bool
Text
ResetImageAttributeName
imageId :: Text
attribute :: ResetImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:ResetImageAttribute' :: ResetImageAttribute -> Text
$sel:attribute:ResetImageAttribute' :: ResetImageAttribute -> ResetImageAttributeName
$sel:dryRun:ResetImageAttribute' :: ResetImageAttribute -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResetImageAttributeName
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId

instance Prelude.NFData ResetImageAttribute where
  rnf :: ResetImageAttribute -> ()
rnf ResetImageAttribute' {Maybe Bool
Text
ResetImageAttributeName
imageId :: Text
attribute :: ResetImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:ResetImageAttribute' :: ResetImageAttribute -> Text
$sel:attribute:ResetImageAttribute' :: ResetImageAttribute -> ResetImageAttributeName
$sel:dryRun:ResetImageAttribute' :: ResetImageAttribute -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResetImageAttributeName
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId

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

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

instance Data.ToQuery ResetImageAttribute where
  toQuery :: ResetImageAttribute -> QueryString
toQuery ResetImageAttribute' {Maybe Bool
Text
ResetImageAttributeName
imageId :: Text
attribute :: ResetImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:ResetImageAttribute' :: ResetImageAttribute -> Text
$sel:attribute:ResetImageAttribute' :: ResetImageAttribute -> ResetImageAttributeName
$sel:dryRun:ResetImageAttribute' :: ResetImageAttribute -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ResetImageAttribute" :: 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,
        ByteString
"Attribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ResetImageAttributeName
attribute,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
imageId
      ]

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

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

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