{-# 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.ModifySnapshotAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds or removes permission settings for the specified snapshot. You may
-- add or remove specified Amazon Web Services account IDs from a
-- snapshot\'s list of create volume permissions, but you cannot do both in
-- a single operation. If you need to both add and remove account IDs for a
-- snapshot, you must use multiple operations. You can make up to 500
-- modifications to a snapshot in a single operation.
--
-- Encrypted snapshots and snapshots with Amazon Web Services Marketplace
-- product codes cannot be made public. Snapshots encrypted with your
-- default KMS key cannot be shared with other accounts.
--
-- For more information about modifying snapshot permissions, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-modifying-snapshot-permissions.html Share a snapshot>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.ModifySnapshotAttribute
  ( -- * Creating a Request
    ModifySnapshotAttribute (..),
    newModifySnapshotAttribute,

    -- * Request Lenses
    modifySnapshotAttribute_attribute,
    modifySnapshotAttribute_createVolumePermission,
    modifySnapshotAttribute_dryRun,
    modifySnapshotAttribute_groupNames,
    modifySnapshotAttribute_operationType,
    modifySnapshotAttribute_userIds,
    modifySnapshotAttribute_snapshotId,

    -- * Destructuring the Response
    ModifySnapshotAttributeResponse (..),
    newModifySnapshotAttributeResponse,
  )
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

-- | /See:/ 'newModifySnapshotAttribute' smart constructor.
data ModifySnapshotAttribute = ModifySnapshotAttribute'
  { -- | The snapshot attribute to modify. Only volume creation permissions can
    -- be modified.
    ModifySnapshotAttribute -> Maybe SnapshotAttributeName
attribute :: Prelude.Maybe SnapshotAttributeName,
    -- | A JSON representation of the snapshot attribute modification.
    ModifySnapshotAttribute
-> Maybe CreateVolumePermissionModifications
createVolumePermission :: Prelude.Maybe CreateVolumePermissionModifications,
    -- | 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@.
    ModifySnapshotAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The group to modify for the snapshot.
    ModifySnapshotAttribute -> Maybe [Text]
groupNames :: Prelude.Maybe [Prelude.Text],
    -- | The type of operation to perform to the attribute.
    ModifySnapshotAttribute -> Maybe OperationType
operationType :: Prelude.Maybe OperationType,
    -- | The account ID to modify for the snapshot.
    ModifySnapshotAttribute -> Maybe [Text]
userIds :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the snapshot.
    ModifySnapshotAttribute -> Text
snapshotId :: Prelude.Text
  }
  deriving (ModifySnapshotAttribute -> ModifySnapshotAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifySnapshotAttribute -> ModifySnapshotAttribute -> Bool
$c/= :: ModifySnapshotAttribute -> ModifySnapshotAttribute -> Bool
== :: ModifySnapshotAttribute -> ModifySnapshotAttribute -> Bool
$c== :: ModifySnapshotAttribute -> ModifySnapshotAttribute -> Bool
Prelude.Eq, ReadPrec [ModifySnapshotAttribute]
ReadPrec ModifySnapshotAttribute
Int -> ReadS ModifySnapshotAttribute
ReadS [ModifySnapshotAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifySnapshotAttribute]
$creadListPrec :: ReadPrec [ModifySnapshotAttribute]
readPrec :: ReadPrec ModifySnapshotAttribute
$creadPrec :: ReadPrec ModifySnapshotAttribute
readList :: ReadS [ModifySnapshotAttribute]
$creadList :: ReadS [ModifySnapshotAttribute]
readsPrec :: Int -> ReadS ModifySnapshotAttribute
$creadsPrec :: Int -> ReadS ModifySnapshotAttribute
Prelude.Read, Int -> ModifySnapshotAttribute -> ShowS
[ModifySnapshotAttribute] -> ShowS
ModifySnapshotAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifySnapshotAttribute] -> ShowS
$cshowList :: [ModifySnapshotAttribute] -> ShowS
show :: ModifySnapshotAttribute -> String
$cshow :: ModifySnapshotAttribute -> String
showsPrec :: Int -> ModifySnapshotAttribute -> ShowS
$cshowsPrec :: Int -> ModifySnapshotAttribute -> ShowS
Prelude.Show, forall x. Rep ModifySnapshotAttribute x -> ModifySnapshotAttribute
forall x. ModifySnapshotAttribute -> Rep ModifySnapshotAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifySnapshotAttribute x -> ModifySnapshotAttribute
$cfrom :: forall x. ModifySnapshotAttribute -> Rep ModifySnapshotAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifySnapshotAttribute' 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', 'modifySnapshotAttribute_attribute' - The snapshot attribute to modify. Only volume creation permissions can
-- be modified.
--
-- 'createVolumePermission', 'modifySnapshotAttribute_createVolumePermission' - A JSON representation of the snapshot attribute modification.
--
-- 'dryRun', 'modifySnapshotAttribute_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@.
--
-- 'groupNames', 'modifySnapshotAttribute_groupNames' - The group to modify for the snapshot.
--
-- 'operationType', 'modifySnapshotAttribute_operationType' - The type of operation to perform to the attribute.
--
-- 'userIds', 'modifySnapshotAttribute_userIds' - The account ID to modify for the snapshot.
--
-- 'snapshotId', 'modifySnapshotAttribute_snapshotId' - The ID of the snapshot.
newModifySnapshotAttribute ::
  -- | 'snapshotId'
  Prelude.Text ->
  ModifySnapshotAttribute
newModifySnapshotAttribute :: Text -> ModifySnapshotAttribute
newModifySnapshotAttribute Text
pSnapshotId_ =
  ModifySnapshotAttribute'
    { $sel:attribute:ModifySnapshotAttribute' :: Maybe SnapshotAttributeName
attribute =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createVolumePermission:ModifySnapshotAttribute' :: Maybe CreateVolumePermissionModifications
createVolumePermission = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifySnapshotAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:groupNames:ModifySnapshotAttribute' :: Maybe [Text]
groupNames = forall a. Maybe a
Prelude.Nothing,
      $sel:operationType:ModifySnapshotAttribute' :: Maybe OperationType
operationType = forall a. Maybe a
Prelude.Nothing,
      $sel:userIds:ModifySnapshotAttribute' :: Maybe [Text]
userIds = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:ModifySnapshotAttribute' :: Text
snapshotId = Text
pSnapshotId_
    }

-- | The snapshot attribute to modify. Only volume creation permissions can
-- be modified.
modifySnapshotAttribute_attribute :: Lens.Lens' ModifySnapshotAttribute (Prelude.Maybe SnapshotAttributeName)
modifySnapshotAttribute_attribute :: Lens' ModifySnapshotAttribute (Maybe SnapshotAttributeName)
modifySnapshotAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Maybe SnapshotAttributeName
attribute :: Maybe SnapshotAttributeName
$sel:attribute:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe SnapshotAttributeName
attribute} -> Maybe SnapshotAttributeName
attribute) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Maybe SnapshotAttributeName
a -> ModifySnapshotAttribute
s {$sel:attribute:ModifySnapshotAttribute' :: Maybe SnapshotAttributeName
attribute = Maybe SnapshotAttributeName
a} :: ModifySnapshotAttribute)

-- | A JSON representation of the snapshot attribute modification.
modifySnapshotAttribute_createVolumePermission :: Lens.Lens' ModifySnapshotAttribute (Prelude.Maybe CreateVolumePermissionModifications)
modifySnapshotAttribute_createVolumePermission :: Lens'
  ModifySnapshotAttribute (Maybe CreateVolumePermissionModifications)
modifySnapshotAttribute_createVolumePermission = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Maybe CreateVolumePermissionModifications
createVolumePermission :: Maybe CreateVolumePermissionModifications
$sel:createVolumePermission:ModifySnapshotAttribute' :: ModifySnapshotAttribute
-> Maybe CreateVolumePermissionModifications
createVolumePermission} -> Maybe CreateVolumePermissionModifications
createVolumePermission) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Maybe CreateVolumePermissionModifications
a -> ModifySnapshotAttribute
s {$sel:createVolumePermission:ModifySnapshotAttribute' :: Maybe CreateVolumePermissionModifications
createVolumePermission = Maybe CreateVolumePermissionModifications
a} :: ModifySnapshotAttribute)

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

-- | The group to modify for the snapshot.
modifySnapshotAttribute_groupNames :: Lens.Lens' ModifySnapshotAttribute (Prelude.Maybe [Prelude.Text])
modifySnapshotAttribute_groupNames :: Lens' ModifySnapshotAttribute (Maybe [Text])
modifySnapshotAttribute_groupNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Maybe [Text]
groupNames :: Maybe [Text]
$sel:groupNames:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
groupNames} -> Maybe [Text]
groupNames) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Maybe [Text]
a -> ModifySnapshotAttribute
s {$sel:groupNames:ModifySnapshotAttribute' :: Maybe [Text]
groupNames = Maybe [Text]
a} :: ModifySnapshotAttribute) 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 type of operation to perform to the attribute.
modifySnapshotAttribute_operationType :: Lens.Lens' ModifySnapshotAttribute (Prelude.Maybe OperationType)
modifySnapshotAttribute_operationType :: Lens' ModifySnapshotAttribute (Maybe OperationType)
modifySnapshotAttribute_operationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Maybe OperationType
operationType :: Maybe OperationType
$sel:operationType:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe OperationType
operationType} -> Maybe OperationType
operationType) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Maybe OperationType
a -> ModifySnapshotAttribute
s {$sel:operationType:ModifySnapshotAttribute' :: Maybe OperationType
operationType = Maybe OperationType
a} :: ModifySnapshotAttribute)

-- | The account ID to modify for the snapshot.
modifySnapshotAttribute_userIds :: Lens.Lens' ModifySnapshotAttribute (Prelude.Maybe [Prelude.Text])
modifySnapshotAttribute_userIds :: Lens' ModifySnapshotAttribute (Maybe [Text])
modifySnapshotAttribute_userIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Maybe [Text]
userIds :: Maybe [Text]
$sel:userIds:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
userIds} -> Maybe [Text]
userIds) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Maybe [Text]
a -> ModifySnapshotAttribute
s {$sel:userIds:ModifySnapshotAttribute' :: Maybe [Text]
userIds = Maybe [Text]
a} :: ModifySnapshotAttribute) 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 ID of the snapshot.
modifySnapshotAttribute_snapshotId :: Lens.Lens' ModifySnapshotAttribute Prelude.Text
modifySnapshotAttribute_snapshotId :: Lens' ModifySnapshotAttribute Text
modifySnapshotAttribute_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotAttribute' {Text
snapshotId :: Text
$sel:snapshotId:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Text
snapshotId} -> Text
snapshotId) (\s :: ModifySnapshotAttribute
s@ModifySnapshotAttribute' {} Text
a -> ModifySnapshotAttribute
s {$sel:snapshotId:ModifySnapshotAttribute' :: Text
snapshotId = Text
a} :: ModifySnapshotAttribute)

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

instance Prelude.Hashable ModifySnapshotAttribute where
  hashWithSalt :: Int -> ModifySnapshotAttribute -> Int
hashWithSalt Int
_salt ModifySnapshotAttribute' {Maybe Bool
Maybe [Text]
Maybe OperationType
Maybe CreateVolumePermissionModifications
Maybe SnapshotAttributeName
Text
snapshotId :: Text
userIds :: Maybe [Text]
operationType :: Maybe OperationType
groupNames :: Maybe [Text]
dryRun :: Maybe Bool
createVolumePermission :: Maybe CreateVolumePermissionModifications
attribute :: Maybe SnapshotAttributeName
$sel:snapshotId:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Text
$sel:userIds:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:operationType:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe OperationType
$sel:groupNames:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:dryRun:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe Bool
$sel:createVolumePermission:ModifySnapshotAttribute' :: ModifySnapshotAttribute
-> Maybe CreateVolumePermissionModifications
$sel:attribute:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe SnapshotAttributeName
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnapshotAttributeName
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateVolumePermissionModifications
createVolumePermission
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groupNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationType
operationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
userIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId

instance Prelude.NFData ModifySnapshotAttribute where
  rnf :: ModifySnapshotAttribute -> ()
rnf ModifySnapshotAttribute' {Maybe Bool
Maybe [Text]
Maybe OperationType
Maybe CreateVolumePermissionModifications
Maybe SnapshotAttributeName
Text
snapshotId :: Text
userIds :: Maybe [Text]
operationType :: Maybe OperationType
groupNames :: Maybe [Text]
dryRun :: Maybe Bool
createVolumePermission :: Maybe CreateVolumePermissionModifications
attribute :: Maybe SnapshotAttributeName
$sel:snapshotId:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Text
$sel:userIds:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:operationType:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe OperationType
$sel:groupNames:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:dryRun:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe Bool
$sel:createVolumePermission:ModifySnapshotAttribute' :: ModifySnapshotAttribute
-> Maybe CreateVolumePermissionModifications
$sel:attribute:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe SnapshotAttributeName
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SnapshotAttributeName
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateVolumePermissionModifications
createVolumePermission
      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 [Text]
groupNames
      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]
userIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId

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

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

instance Data.ToQuery ModifySnapshotAttribute where
  toQuery :: ModifySnapshotAttribute -> QueryString
toQuery ModifySnapshotAttribute' {Maybe Bool
Maybe [Text]
Maybe OperationType
Maybe CreateVolumePermissionModifications
Maybe SnapshotAttributeName
Text
snapshotId :: Text
userIds :: Maybe [Text]
operationType :: Maybe OperationType
groupNames :: Maybe [Text]
dryRun :: Maybe Bool
createVolumePermission :: Maybe CreateVolumePermissionModifications
attribute :: Maybe SnapshotAttributeName
$sel:snapshotId:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Text
$sel:userIds:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:operationType:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe OperationType
$sel:groupNames:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe [Text]
$sel:dryRun:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe Bool
$sel:createVolumePermission:ModifySnapshotAttribute' :: ModifySnapshotAttribute
-> Maybe CreateVolumePermissionModifications
$sel:attribute:ModifySnapshotAttribute' :: ModifySnapshotAttribute -> Maybe SnapshotAttributeName
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifySnapshotAttribute" :: 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 SnapshotAttributeName
attribute,
        ByteString
"CreateVolumePermission"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CreateVolumePermissionModifications
createVolumePermission,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        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]
groupNames
          ),
        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
"UserId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
userIds),
        ByteString
"SnapshotId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
snapshotId
      ]

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

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

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