{-# 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.SSM.ModifyDocumentPermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Shares a Amazon Web Services Systems Manager document (SSM
-- document)publicly or privately. If you share a document privately, you
-- must specify the Amazon Web Services user account IDs for those people
-- who can use the document. If you share a document publicly, you must
-- specify /All/ as the account ID.
module Amazonka.SSM.ModifyDocumentPermission
  ( -- * Creating a Request
    ModifyDocumentPermission (..),
    newModifyDocumentPermission,

    -- * Request Lenses
    modifyDocumentPermission_accountIdsToAdd,
    modifyDocumentPermission_accountIdsToRemove,
    modifyDocumentPermission_sharedDocumentVersion,
    modifyDocumentPermission_name,
    modifyDocumentPermission_permissionType,

    -- * Destructuring the Response
    ModifyDocumentPermissionResponse (..),
    newModifyDocumentPermissionResponse,

    -- * Response Lenses
    modifyDocumentPermissionResponse_httpStatus,
  )
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.SSM.Types

-- | /See:/ 'newModifyDocumentPermission' smart constructor.
data ModifyDocumentPermission = ModifyDocumentPermission'
  { -- | The Amazon Web Services user accounts that should have access to the
    -- document. The account IDs can either be a group of account IDs or /All/.
    ModifyDocumentPermission -> Maybe [Text]
accountIdsToAdd :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Web Services user accounts that should no longer have access
    -- to the document. The Amazon Web Services user account can either be a
    -- group of account IDs or /All/. This action has a higher priority than
    -- /AccountIdsToAdd/. If you specify an account ID to add and the same ID
    -- to remove, the system removes access to the document.
    ModifyDocumentPermission -> Maybe [Text]
accountIdsToRemove :: Prelude.Maybe [Prelude.Text],
    -- | (Optional) The version of the document to share. If it isn\'t specified,
    -- the system choose the @Default@ version to share.
    ModifyDocumentPermission -> Maybe Text
sharedDocumentVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the document that you want to share.
    ModifyDocumentPermission -> Text
name :: Prelude.Text,
    -- | The permission type for the document. The permission type can be
    -- /Share/.
    ModifyDocumentPermission -> DocumentPermissionType
permissionType :: DocumentPermissionType
  }
  deriving (ModifyDocumentPermission -> ModifyDocumentPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDocumentPermission -> ModifyDocumentPermission -> Bool
$c/= :: ModifyDocumentPermission -> ModifyDocumentPermission -> Bool
== :: ModifyDocumentPermission -> ModifyDocumentPermission -> Bool
$c== :: ModifyDocumentPermission -> ModifyDocumentPermission -> Bool
Prelude.Eq, ReadPrec [ModifyDocumentPermission]
ReadPrec ModifyDocumentPermission
Int -> ReadS ModifyDocumentPermission
ReadS [ModifyDocumentPermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDocumentPermission]
$creadListPrec :: ReadPrec [ModifyDocumentPermission]
readPrec :: ReadPrec ModifyDocumentPermission
$creadPrec :: ReadPrec ModifyDocumentPermission
readList :: ReadS [ModifyDocumentPermission]
$creadList :: ReadS [ModifyDocumentPermission]
readsPrec :: Int -> ReadS ModifyDocumentPermission
$creadsPrec :: Int -> ReadS ModifyDocumentPermission
Prelude.Read, Int -> ModifyDocumentPermission -> ShowS
[ModifyDocumentPermission] -> ShowS
ModifyDocumentPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDocumentPermission] -> ShowS
$cshowList :: [ModifyDocumentPermission] -> ShowS
show :: ModifyDocumentPermission -> String
$cshow :: ModifyDocumentPermission -> String
showsPrec :: Int -> ModifyDocumentPermission -> ShowS
$cshowsPrec :: Int -> ModifyDocumentPermission -> ShowS
Prelude.Show, forall x.
Rep ModifyDocumentPermission x -> ModifyDocumentPermission
forall x.
ModifyDocumentPermission -> Rep ModifyDocumentPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyDocumentPermission x -> ModifyDocumentPermission
$cfrom :: forall x.
ModifyDocumentPermission -> Rep ModifyDocumentPermission x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDocumentPermission' 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:
--
-- 'accountIdsToAdd', 'modifyDocumentPermission_accountIdsToAdd' - The Amazon Web Services user accounts that should have access to the
-- document. The account IDs can either be a group of account IDs or /All/.
--
-- 'accountIdsToRemove', 'modifyDocumentPermission_accountIdsToRemove' - The Amazon Web Services user accounts that should no longer have access
-- to the document. The Amazon Web Services user account can either be a
-- group of account IDs or /All/. This action has a higher priority than
-- /AccountIdsToAdd/. If you specify an account ID to add and the same ID
-- to remove, the system removes access to the document.
--
-- 'sharedDocumentVersion', 'modifyDocumentPermission_sharedDocumentVersion' - (Optional) The version of the document to share. If it isn\'t specified,
-- the system choose the @Default@ version to share.
--
-- 'name', 'modifyDocumentPermission_name' - The name of the document that you want to share.
--
-- 'permissionType', 'modifyDocumentPermission_permissionType' - The permission type for the document. The permission type can be
-- /Share/.
newModifyDocumentPermission ::
  -- | 'name'
  Prelude.Text ->
  -- | 'permissionType'
  DocumentPermissionType ->
  ModifyDocumentPermission
newModifyDocumentPermission :: Text -> DocumentPermissionType -> ModifyDocumentPermission
newModifyDocumentPermission Text
pName_ DocumentPermissionType
pPermissionType_ =
  ModifyDocumentPermission'
    { $sel:accountIdsToAdd:ModifyDocumentPermission' :: Maybe [Text]
accountIdsToAdd =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accountIdsToRemove:ModifyDocumentPermission' :: Maybe [Text]
accountIdsToRemove = forall a. Maybe a
Prelude.Nothing,
      $sel:sharedDocumentVersion:ModifyDocumentPermission' :: Maybe Text
sharedDocumentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:name:ModifyDocumentPermission' :: Text
name = Text
pName_,
      $sel:permissionType:ModifyDocumentPermission' :: DocumentPermissionType
permissionType = DocumentPermissionType
pPermissionType_
    }

-- | The Amazon Web Services user accounts that should have access to the
-- document. The account IDs can either be a group of account IDs or /All/.
modifyDocumentPermission_accountIdsToAdd :: Lens.Lens' ModifyDocumentPermission (Prelude.Maybe [Prelude.Text])
modifyDocumentPermission_accountIdsToAdd :: Lens' ModifyDocumentPermission (Maybe [Text])
modifyDocumentPermission_accountIdsToAdd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermission' {Maybe [Text]
accountIdsToAdd :: Maybe [Text]
$sel:accountIdsToAdd:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
accountIdsToAdd} -> Maybe [Text]
accountIdsToAdd) (\s :: ModifyDocumentPermission
s@ModifyDocumentPermission' {} Maybe [Text]
a -> ModifyDocumentPermission
s {$sel:accountIdsToAdd:ModifyDocumentPermission' :: Maybe [Text]
accountIdsToAdd = Maybe [Text]
a} :: ModifyDocumentPermission) 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 user accounts that should no longer have access
-- to the document. The Amazon Web Services user account can either be a
-- group of account IDs or /All/. This action has a higher priority than
-- /AccountIdsToAdd/. If you specify an account ID to add and the same ID
-- to remove, the system removes access to the document.
modifyDocumentPermission_accountIdsToRemove :: Lens.Lens' ModifyDocumentPermission (Prelude.Maybe [Prelude.Text])
modifyDocumentPermission_accountIdsToRemove :: Lens' ModifyDocumentPermission (Maybe [Text])
modifyDocumentPermission_accountIdsToRemove = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermission' {Maybe [Text]
accountIdsToRemove :: Maybe [Text]
$sel:accountIdsToRemove:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
accountIdsToRemove} -> Maybe [Text]
accountIdsToRemove) (\s :: ModifyDocumentPermission
s@ModifyDocumentPermission' {} Maybe [Text]
a -> ModifyDocumentPermission
s {$sel:accountIdsToRemove:ModifyDocumentPermission' :: Maybe [Text]
accountIdsToRemove = Maybe [Text]
a} :: ModifyDocumentPermission) 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

-- | (Optional) The version of the document to share. If it isn\'t specified,
-- the system choose the @Default@ version to share.
modifyDocumentPermission_sharedDocumentVersion :: Lens.Lens' ModifyDocumentPermission (Prelude.Maybe Prelude.Text)
modifyDocumentPermission_sharedDocumentVersion :: Lens' ModifyDocumentPermission (Maybe Text)
modifyDocumentPermission_sharedDocumentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermission' {Maybe Text
sharedDocumentVersion :: Maybe Text
$sel:sharedDocumentVersion:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe Text
sharedDocumentVersion} -> Maybe Text
sharedDocumentVersion) (\s :: ModifyDocumentPermission
s@ModifyDocumentPermission' {} Maybe Text
a -> ModifyDocumentPermission
s {$sel:sharedDocumentVersion:ModifyDocumentPermission' :: Maybe Text
sharedDocumentVersion = Maybe Text
a} :: ModifyDocumentPermission)

-- | The name of the document that you want to share.
modifyDocumentPermission_name :: Lens.Lens' ModifyDocumentPermission Prelude.Text
modifyDocumentPermission_name :: Lens' ModifyDocumentPermission Text
modifyDocumentPermission_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermission' {Text
name :: Text
$sel:name:ModifyDocumentPermission' :: ModifyDocumentPermission -> Text
name} -> Text
name) (\s :: ModifyDocumentPermission
s@ModifyDocumentPermission' {} Text
a -> ModifyDocumentPermission
s {$sel:name:ModifyDocumentPermission' :: Text
name = Text
a} :: ModifyDocumentPermission)

-- | The permission type for the document. The permission type can be
-- /Share/.
modifyDocumentPermission_permissionType :: Lens.Lens' ModifyDocumentPermission DocumentPermissionType
modifyDocumentPermission_permissionType :: Lens' ModifyDocumentPermission DocumentPermissionType
modifyDocumentPermission_permissionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermission' {DocumentPermissionType
permissionType :: DocumentPermissionType
$sel:permissionType:ModifyDocumentPermission' :: ModifyDocumentPermission -> DocumentPermissionType
permissionType} -> DocumentPermissionType
permissionType) (\s :: ModifyDocumentPermission
s@ModifyDocumentPermission' {} DocumentPermissionType
a -> ModifyDocumentPermission
s {$sel:permissionType:ModifyDocumentPermission' :: DocumentPermissionType
permissionType = DocumentPermissionType
a} :: ModifyDocumentPermission)

instance Core.AWSRequest ModifyDocumentPermission where
  type
    AWSResponse ModifyDocumentPermission =
      ModifyDocumentPermissionResponse
  request :: (Service -> Service)
-> ModifyDocumentPermission -> Request ModifyDocumentPermission
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyDocumentPermission
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyDocumentPermission)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> ModifyDocumentPermissionResponse
ModifyDocumentPermissionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ModifyDocumentPermission where
  hashWithSalt :: Int -> ModifyDocumentPermission -> Int
hashWithSalt Int
_salt ModifyDocumentPermission' {Maybe [Text]
Maybe Text
Text
DocumentPermissionType
permissionType :: DocumentPermissionType
name :: Text
sharedDocumentVersion :: Maybe Text
accountIdsToRemove :: Maybe [Text]
accountIdsToAdd :: Maybe [Text]
$sel:permissionType:ModifyDocumentPermission' :: ModifyDocumentPermission -> DocumentPermissionType
$sel:name:ModifyDocumentPermission' :: ModifyDocumentPermission -> Text
$sel:sharedDocumentVersion:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe Text
$sel:accountIdsToRemove:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
$sel:accountIdsToAdd:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
accountIdsToAdd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
accountIdsToRemove
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sharedDocumentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DocumentPermissionType
permissionType

instance Prelude.NFData ModifyDocumentPermission where
  rnf :: ModifyDocumentPermission -> ()
rnf ModifyDocumentPermission' {Maybe [Text]
Maybe Text
Text
DocumentPermissionType
permissionType :: DocumentPermissionType
name :: Text
sharedDocumentVersion :: Maybe Text
accountIdsToRemove :: Maybe [Text]
accountIdsToAdd :: Maybe [Text]
$sel:permissionType:ModifyDocumentPermission' :: ModifyDocumentPermission -> DocumentPermissionType
$sel:name:ModifyDocumentPermission' :: ModifyDocumentPermission -> Text
$sel:sharedDocumentVersion:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe Text
$sel:accountIdsToRemove:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
$sel:accountIdsToAdd:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
accountIdsToAdd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
accountIdsToRemove
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sharedDocumentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DocumentPermissionType
permissionType

instance Data.ToHeaders ModifyDocumentPermission where
  toHeaders :: ModifyDocumentPermission -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonSSM.ModifyDocumentPermission" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ModifyDocumentPermission where
  toJSON :: ModifyDocumentPermission -> Value
toJSON ModifyDocumentPermission' {Maybe [Text]
Maybe Text
Text
DocumentPermissionType
permissionType :: DocumentPermissionType
name :: Text
sharedDocumentVersion :: Maybe Text
accountIdsToRemove :: Maybe [Text]
accountIdsToAdd :: Maybe [Text]
$sel:permissionType:ModifyDocumentPermission' :: ModifyDocumentPermission -> DocumentPermissionType
$sel:name:ModifyDocumentPermission' :: ModifyDocumentPermission -> Text
$sel:sharedDocumentVersion:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe Text
$sel:accountIdsToRemove:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
$sel:accountIdsToAdd:ModifyDocumentPermission' :: ModifyDocumentPermission -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountIdsToAdd" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
accountIdsToAdd,
            (Key
"AccountIdsToRemove" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
accountIdsToRemove,
            (Key
"SharedDocumentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sharedDocumentVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PermissionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DocumentPermissionType
permissionType)
          ]
      )

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

instance Data.ToQuery ModifyDocumentPermission where
  toQuery :: ModifyDocumentPermission -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'ModifyDocumentPermissionResponse' 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:
--
-- 'httpStatus', 'modifyDocumentPermissionResponse_httpStatus' - The response's http status code.
newModifyDocumentPermissionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDocumentPermissionResponse
newModifyDocumentPermissionResponse :: Int -> ModifyDocumentPermissionResponse
newModifyDocumentPermissionResponse Int
pHttpStatus_ =
  ModifyDocumentPermissionResponse'
    { $sel:httpStatus:ModifyDocumentPermissionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
modifyDocumentPermissionResponse_httpStatus :: Lens.Lens' ModifyDocumentPermissionResponse Prelude.Int
modifyDocumentPermissionResponse_httpStatus :: Lens' ModifyDocumentPermissionResponse Int
modifyDocumentPermissionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDocumentPermissionResponse' {Int
httpStatus :: Int
$sel:httpStatus:ModifyDocumentPermissionResponse' :: ModifyDocumentPermissionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ModifyDocumentPermissionResponse
s@ModifyDocumentPermissionResponse' {} Int
a -> ModifyDocumentPermissionResponse
s {$sel:httpStatus:ModifyDocumentPermissionResponse' :: Int
httpStatus = Int
a} :: ModifyDocumentPermissionResponse)

instance
  Prelude.NFData
    ModifyDocumentPermissionResponse
  where
  rnf :: ModifyDocumentPermissionResponse -> ()
rnf ModifyDocumentPermissionResponse' {Int
httpStatus :: Int
$sel:httpStatus:ModifyDocumentPermissionResponse' :: ModifyDocumentPermissionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus