{-# 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.ModifyImageAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the specified attribute of the specified AMI. You can specify
-- only one attribute at a time. You can use the @Attribute@ parameter to
-- specify the attribute or one of the following parameters: @Description@
-- or @LaunchPermission@.
--
-- Images with an Amazon Web Services Marketplace product code cannot be
-- made public.
--
-- To enable the SriovNetSupport enhanced networking attribute of an image,
-- enable SriovNetSupport on an instance and create an AMI from the
-- instance.
module Amazonka.EC2.ModifyImageAttribute
  ( -- * Creating a Request
    ModifyImageAttribute (..),
    newModifyImageAttribute,

    -- * Request Lenses
    modifyImageAttribute_attribute,
    modifyImageAttribute_description,
    modifyImageAttribute_dryRun,
    modifyImageAttribute_launchPermission,
    modifyImageAttribute_operationType,
    modifyImageAttribute_organizationArns,
    modifyImageAttribute_organizationalUnitArns,
    modifyImageAttribute_productCodes,
    modifyImageAttribute_userGroups,
    modifyImageAttribute_userIds,
    modifyImageAttribute_value,
    modifyImageAttribute_imageId,

    -- * Destructuring the Response
    ModifyImageAttributeResponse (..),
    newModifyImageAttributeResponse,
  )
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 ModifyImageAttribute.
--
-- /See:/ 'newModifyImageAttribute' smart constructor.
data ModifyImageAttribute = ModifyImageAttribute'
  { -- | The name of the attribute to modify.
    --
    -- Valid values: @description@ | @launchPermission@
    ModifyImageAttribute -> Maybe Text
attribute :: Prelude.Maybe Prelude.Text,
    -- | A new description for the AMI.
    ModifyImageAttribute -> Maybe AttributeValue
description :: Prelude.Maybe AttributeValue,
    -- | 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@.
    ModifyImageAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | A new launch permission for the AMI.
    ModifyImageAttribute -> Maybe LaunchPermissionModifications
launchPermission :: Prelude.Maybe LaunchPermissionModifications,
    -- | The operation type. This parameter can be used only when the @Attribute@
    -- parameter is @launchPermission@.
    ModifyImageAttribute -> Maybe OperationType
operationType :: Prelude.Maybe OperationType,
    -- | The Amazon Resource Name (ARN) of an organization. This parameter can be
    -- used only when the @Attribute@ parameter is @launchPermission@.
    ModifyImageAttribute -> Maybe [Text]
organizationArns :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Resource Name (ARN) of an organizational unit (OU). This
    -- parameter can be used only when the @Attribute@ parameter is
    -- @launchPermission@.
    ModifyImageAttribute -> Maybe [Text]
organizationalUnitArns :: Prelude.Maybe [Prelude.Text],
    -- | Not supported.
    ModifyImageAttribute -> Maybe [Text]
productCodes :: Prelude.Maybe [Prelude.Text],
    -- | The user groups. This parameter can be used only when the @Attribute@
    -- parameter is @launchPermission@.
    ModifyImageAttribute -> Maybe [Text]
userGroups :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Web Services account IDs. This parameter can be used only
    -- when the @Attribute@ parameter is @launchPermission@.
    ModifyImageAttribute -> Maybe [Text]
userIds :: Prelude.Maybe [Prelude.Text],
    -- | The value of the attribute being modified. This parameter can be used
    -- only when the @Attribute@ parameter is @description@.
    ModifyImageAttribute -> Maybe Text
value :: Prelude.Maybe Prelude.Text,
    -- | The ID of the AMI.
    ModifyImageAttribute -> Text
imageId :: Prelude.Text
  }
  deriving (ModifyImageAttribute -> ModifyImageAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyImageAttribute -> ModifyImageAttribute -> Bool
$c/= :: ModifyImageAttribute -> ModifyImageAttribute -> Bool
== :: ModifyImageAttribute -> ModifyImageAttribute -> Bool
$c== :: ModifyImageAttribute -> ModifyImageAttribute -> Bool
Prelude.Eq, ReadPrec [ModifyImageAttribute]
ReadPrec ModifyImageAttribute
Int -> ReadS ModifyImageAttribute
ReadS [ModifyImageAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyImageAttribute]
$creadListPrec :: ReadPrec [ModifyImageAttribute]
readPrec :: ReadPrec ModifyImageAttribute
$creadPrec :: ReadPrec ModifyImageAttribute
readList :: ReadS [ModifyImageAttribute]
$creadList :: ReadS [ModifyImageAttribute]
readsPrec :: Int -> ReadS ModifyImageAttribute
$creadsPrec :: Int -> ReadS ModifyImageAttribute
Prelude.Read, Int -> ModifyImageAttribute -> ShowS
[ModifyImageAttribute] -> ShowS
ModifyImageAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyImageAttribute] -> ShowS
$cshowList :: [ModifyImageAttribute] -> ShowS
show :: ModifyImageAttribute -> String
$cshow :: ModifyImageAttribute -> String
showsPrec :: Int -> ModifyImageAttribute -> ShowS
$cshowsPrec :: Int -> ModifyImageAttribute -> ShowS
Prelude.Show, forall x. Rep ModifyImageAttribute x -> ModifyImageAttribute
forall x. ModifyImageAttribute -> Rep ModifyImageAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyImageAttribute x -> ModifyImageAttribute
$cfrom :: forall x. ModifyImageAttribute -> Rep ModifyImageAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifyImageAttribute' 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:
--
-- 'attribute', 'modifyImageAttribute_attribute' - The name of the attribute to modify.
--
-- Valid values: @description@ | @launchPermission@
--
-- 'description', 'modifyImageAttribute_description' - A new description for the AMI.
--
-- 'dryRun', 'modifyImageAttribute_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@.
--
-- 'launchPermission', 'modifyImageAttribute_launchPermission' - A new launch permission for the AMI.
--
-- 'operationType', 'modifyImageAttribute_operationType' - The operation type. This parameter can be used only when the @Attribute@
-- parameter is @launchPermission@.
--
-- 'organizationArns', 'modifyImageAttribute_organizationArns' - The Amazon Resource Name (ARN) of an organization. This parameter can be
-- used only when the @Attribute@ parameter is @launchPermission@.
--
-- 'organizationalUnitArns', 'modifyImageAttribute_organizationalUnitArns' - The Amazon Resource Name (ARN) of an organizational unit (OU). This
-- parameter can be used only when the @Attribute@ parameter is
-- @launchPermission@.
--
-- 'productCodes', 'modifyImageAttribute_productCodes' - Not supported.
--
-- 'userGroups', 'modifyImageAttribute_userGroups' - The user groups. This parameter can be used only when the @Attribute@
-- parameter is @launchPermission@.
--
-- 'userIds', 'modifyImageAttribute_userIds' - The Amazon Web Services account IDs. This parameter can be used only
-- when the @Attribute@ parameter is @launchPermission@.
--
-- 'value', 'modifyImageAttribute_value' - The value of the attribute being modified. This parameter can be used
-- only when the @Attribute@ parameter is @description@.
--
-- 'imageId', 'modifyImageAttribute_imageId' - The ID of the AMI.
newModifyImageAttribute ::
  -- | 'imageId'
  Prelude.Text ->
  ModifyImageAttribute
newModifyImageAttribute :: Text -> ModifyImageAttribute
newModifyImageAttribute Text
pImageId_ =
  ModifyImageAttribute'
    { $sel:attribute:ModifyImageAttribute' :: Maybe Text
attribute = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ModifyImageAttribute' :: Maybe AttributeValue
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyImageAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:launchPermission:ModifyImageAttribute' :: Maybe LaunchPermissionModifications
launchPermission = forall a. Maybe a
Prelude.Nothing,
      $sel:operationType:ModifyImageAttribute' :: Maybe OperationType
operationType = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationArns:ModifyImageAttribute' :: Maybe [Text]
organizationArns = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationalUnitArns:ModifyImageAttribute' :: Maybe [Text]
organizationalUnitArns = forall a. Maybe a
Prelude.Nothing,
      $sel:productCodes:ModifyImageAttribute' :: Maybe [Text]
productCodes = forall a. Maybe a
Prelude.Nothing,
      $sel:userGroups:ModifyImageAttribute' :: Maybe [Text]
userGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:userIds:ModifyImageAttribute' :: Maybe [Text]
userIds = forall a. Maybe a
Prelude.Nothing,
      $sel:value:ModifyImageAttribute' :: Maybe Text
value = forall a. Maybe a
Prelude.Nothing,
      $sel:imageId:ModifyImageAttribute' :: Text
imageId = Text
pImageId_
    }

-- | The name of the attribute to modify.
--
-- Valid values: @description@ | @launchPermission@
modifyImageAttribute_attribute :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe Prelude.Text)
modifyImageAttribute_attribute :: Lens' ModifyImageAttribute (Maybe Text)
modifyImageAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe Text
attribute :: Maybe Text
$sel:attribute:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
attribute} -> Maybe Text
attribute) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe Text
a -> ModifyImageAttribute
s {$sel:attribute:ModifyImageAttribute' :: Maybe Text
attribute = Maybe Text
a} :: ModifyImageAttribute)

-- | A new description for the AMI.
modifyImageAttribute_description :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe AttributeValue)
modifyImageAttribute_description :: Lens' ModifyImageAttribute (Maybe AttributeValue)
modifyImageAttribute_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe AttributeValue
description :: Maybe AttributeValue
$sel:description:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe AttributeValue
description} -> Maybe AttributeValue
description) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe AttributeValue
a -> ModifyImageAttribute
s {$sel:description:ModifyImageAttribute' :: Maybe AttributeValue
description = Maybe AttributeValue
a} :: ModifyImageAttribute)

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

-- | A new launch permission for the AMI.
modifyImageAttribute_launchPermission :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe LaunchPermissionModifications)
modifyImageAttribute_launchPermission :: Lens' ModifyImageAttribute (Maybe LaunchPermissionModifications)
modifyImageAttribute_launchPermission = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe LaunchPermissionModifications
launchPermission :: Maybe LaunchPermissionModifications
$sel:launchPermission:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe LaunchPermissionModifications
launchPermission} -> Maybe LaunchPermissionModifications
launchPermission) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe LaunchPermissionModifications
a -> ModifyImageAttribute
s {$sel:launchPermission:ModifyImageAttribute' :: Maybe LaunchPermissionModifications
launchPermission = Maybe LaunchPermissionModifications
a} :: ModifyImageAttribute)

-- | The operation type. This parameter can be used only when the @Attribute@
-- parameter is @launchPermission@.
modifyImageAttribute_operationType :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe OperationType)
modifyImageAttribute_operationType :: Lens' ModifyImageAttribute (Maybe OperationType)
modifyImageAttribute_operationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe OperationType
operationType :: Maybe OperationType
$sel:operationType:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe OperationType
operationType} -> Maybe OperationType
operationType) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe OperationType
a -> ModifyImageAttribute
s {$sel:operationType:ModifyImageAttribute' :: Maybe OperationType
operationType = Maybe OperationType
a} :: ModifyImageAttribute)

-- | The Amazon Resource Name (ARN) of an organization. This parameter can be
-- used only when the @Attribute@ parameter is @launchPermission@.
modifyImageAttribute_organizationArns :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe [Prelude.Text])
modifyImageAttribute_organizationArns :: Lens' ModifyImageAttribute (Maybe [Text])
modifyImageAttribute_organizationArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe [Text]
organizationArns :: Maybe [Text]
$sel:organizationArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
organizationArns} -> Maybe [Text]
organizationArns) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe [Text]
a -> ModifyImageAttribute
s {$sel:organizationArns:ModifyImageAttribute' :: Maybe [Text]
organizationArns = Maybe [Text]
a} :: ModifyImageAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name (ARN) of an organizational unit (OU). This
-- parameter can be used only when the @Attribute@ parameter is
-- @launchPermission@.
modifyImageAttribute_organizationalUnitArns :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe [Prelude.Text])
modifyImageAttribute_organizationalUnitArns :: Lens' ModifyImageAttribute (Maybe [Text])
modifyImageAttribute_organizationalUnitArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe [Text]
organizationalUnitArns :: Maybe [Text]
$sel:organizationalUnitArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
organizationalUnitArns} -> Maybe [Text]
organizationalUnitArns) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe [Text]
a -> ModifyImageAttribute
s {$sel:organizationalUnitArns:ModifyImageAttribute' :: Maybe [Text]
organizationalUnitArns = Maybe [Text]
a} :: ModifyImageAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Not supported.
modifyImageAttribute_productCodes :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe [Prelude.Text])
modifyImageAttribute_productCodes :: Lens' ModifyImageAttribute (Maybe [Text])
modifyImageAttribute_productCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe [Text]
productCodes :: Maybe [Text]
$sel:productCodes:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
productCodes} -> Maybe [Text]
productCodes) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe [Text]
a -> ModifyImageAttribute
s {$sel:productCodes:ModifyImageAttribute' :: Maybe [Text]
productCodes = Maybe [Text]
a} :: ModifyImageAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The user groups. This parameter can be used only when the @Attribute@
-- parameter is @launchPermission@.
modifyImageAttribute_userGroups :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe [Prelude.Text])
modifyImageAttribute_userGroups :: Lens' ModifyImageAttribute (Maybe [Text])
modifyImageAttribute_userGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe [Text]
userGroups :: Maybe [Text]
$sel:userGroups:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
userGroups} -> Maybe [Text]
userGroups) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe [Text]
a -> ModifyImageAttribute
s {$sel:userGroups:ModifyImageAttribute' :: Maybe [Text]
userGroups = Maybe [Text]
a} :: ModifyImageAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Web Services account IDs. This parameter can be used only
-- when the @Attribute@ parameter is @launchPermission@.
modifyImageAttribute_userIds :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe [Prelude.Text])
modifyImageAttribute_userIds :: Lens' ModifyImageAttribute (Maybe [Text])
modifyImageAttribute_userIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe [Text]
userIds :: Maybe [Text]
$sel:userIds:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
userIds} -> Maybe [Text]
userIds) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe [Text]
a -> ModifyImageAttribute
s {$sel:userIds:ModifyImageAttribute' :: Maybe [Text]
userIds = Maybe [Text]
a} :: ModifyImageAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The value of the attribute being modified. This parameter can be used
-- only when the @Attribute@ parameter is @description@.
modifyImageAttribute_value :: Lens.Lens' ModifyImageAttribute (Prelude.Maybe Prelude.Text)
modifyImageAttribute_value :: Lens' ModifyImageAttribute (Maybe Text)
modifyImageAttribute_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyImageAttribute' {Maybe Text
value :: Maybe Text
$sel:value:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
value} -> Maybe Text
value) (\s :: ModifyImageAttribute
s@ModifyImageAttribute' {} Maybe Text
a -> ModifyImageAttribute
s {$sel:value:ModifyImageAttribute' :: Maybe Text
value = Maybe Text
a} :: ModifyImageAttribute)

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

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

instance Prelude.Hashable ModifyImageAttribute where
  hashWithSalt :: Int -> ModifyImageAttribute -> Int
hashWithSalt Int
_salt ModifyImageAttribute' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AttributeValue
Maybe OperationType
Maybe LaunchPermissionModifications
Text
imageId :: Text
value :: Maybe Text
userIds :: Maybe [Text]
userGroups :: Maybe [Text]
productCodes :: Maybe [Text]
organizationalUnitArns :: Maybe [Text]
organizationArns :: Maybe [Text]
operationType :: Maybe OperationType
launchPermission :: Maybe LaunchPermissionModifications
dryRun :: Maybe Bool
description :: Maybe AttributeValue
attribute :: Maybe Text
$sel:imageId:ModifyImageAttribute' :: ModifyImageAttribute -> Text
$sel:value:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
$sel:userIds:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:userGroups:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:productCodes:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationalUnitArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:operationType:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe OperationType
$sel:launchPermission:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe LaunchPermissionModifications
$sel:dryRun:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Bool
$sel:description:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe AttributeValue
$sel:attribute:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchPermissionModifications
launchPermission
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationType
operationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
organizationArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
organizationalUnitArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
productCodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
userGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
userIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
value
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId

instance Prelude.NFData ModifyImageAttribute where
  rnf :: ModifyImageAttribute -> ()
rnf ModifyImageAttribute' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AttributeValue
Maybe OperationType
Maybe LaunchPermissionModifications
Text
imageId :: Text
value :: Maybe Text
userIds :: Maybe [Text]
userGroups :: Maybe [Text]
productCodes :: Maybe [Text]
organizationalUnitArns :: Maybe [Text]
organizationArns :: Maybe [Text]
operationType :: Maybe OperationType
launchPermission :: Maybe LaunchPermissionModifications
dryRun :: Maybe Bool
description :: Maybe AttributeValue
attribute :: Maybe Text
$sel:imageId:ModifyImageAttribute' :: ModifyImageAttribute -> Text
$sel:value:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
$sel:userIds:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:userGroups:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:productCodes:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationalUnitArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:operationType:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe OperationType
$sel:launchPermission:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe LaunchPermissionModifications
$sel:dryRun:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Bool
$sel:description:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe AttributeValue
$sel:attribute:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe LaunchPermissionModifications
launchPermission
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperationType
operationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
organizationArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
organizationalUnitArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
productCodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
userGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
userIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
value
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId

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

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

instance Data.ToQuery ModifyImageAttribute where
  toQuery :: ModifyImageAttribute -> QueryString
toQuery ModifyImageAttribute' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AttributeValue
Maybe OperationType
Maybe LaunchPermissionModifications
Text
imageId :: Text
value :: Maybe Text
userIds :: Maybe [Text]
userGroups :: Maybe [Text]
productCodes :: Maybe [Text]
organizationalUnitArns :: Maybe [Text]
organizationArns :: Maybe [Text]
operationType :: Maybe OperationType
launchPermission :: Maybe LaunchPermissionModifications
dryRun :: Maybe Bool
description :: Maybe AttributeValue
attribute :: Maybe Text
$sel:imageId:ModifyImageAttribute' :: ModifyImageAttribute -> Text
$sel:value:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
$sel:userIds:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:userGroups:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:productCodes:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationalUnitArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:organizationArns:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe [Text]
$sel:operationType:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe OperationType
$sel:launchPermission:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe LaunchPermissionModifications
$sel:dryRun:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Bool
$sel:description:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe AttributeValue
$sel:attribute:ModifyImageAttribute' :: ModifyImageAttribute -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyImageAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Attribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
attribute,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"LaunchPermission" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LaunchPermissionModifications
launchPermission,
        ByteString
"OperationType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe OperationType
operationType,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"OrganizationArn"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
organizationArns
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"OrganizationalUnitArn"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
organizationalUnitArns
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"ProductCode"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
productCodes
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"UserGroup"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
userGroups
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"UserId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
userIds),
        ByteString
"Value" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
value,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
imageId
      ]

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

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

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