{-# 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.RAM.AssociateResourceSharePermission
-- 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 replaces the RAM permission for a resource type included in a
-- resource share. You can have exactly one permission associated with each
-- resource type in the resource share. You can add a new RAM permission
-- only if there are currently no resources of that resource type currently
-- in the resource share.
module Amazonka.RAM.AssociateResourceSharePermission
  ( -- * Creating a Request
    AssociateResourceSharePermission (..),
    newAssociateResourceSharePermission,

    -- * Request Lenses
    associateResourceSharePermission_clientToken,
    associateResourceSharePermission_permissionVersion,
    associateResourceSharePermission_replace,
    associateResourceSharePermission_resourceShareArn,
    associateResourceSharePermission_permissionArn,

    -- * Destructuring the Response
    AssociateResourceSharePermissionResponse (..),
    newAssociateResourceSharePermissionResponse,

    -- * Response Lenses
    associateResourceSharePermissionResponse_clientToken,
    associateResourceSharePermissionResponse_returnValue,
    associateResourceSharePermissionResponse_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 Amazonka.RAM.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newAssociateResourceSharePermission' smart constructor.
data AssociateResourceSharePermission = AssociateResourceSharePermission'
  { -- | Specifies a unique, case-sensitive identifier that you provide to ensure
    -- the idempotency of the request. This lets you safely retry the request
    -- without accidentally performing the same operation a second time.
    -- Passing the same value to a later call to an operation requires that you
    -- also pass the same value for all other parameters. We recommend that you
    -- use a
    -- <https://wikipedia.org/wiki/Universally_unique_identifier UUID type of value.>.
    --
    -- If you don\'t provide this value, then Amazon Web Services generates a
    -- random one for you.
    AssociateResourceSharePermission -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the version of the RAM permission to associate with the
    -- resource share. If you don\'t specify this parameter, the operation uses
    -- the version designated as the default. You can use the
    -- ListPermissionVersions operation to discover the available versions of a
    -- permission.
    AssociateResourceSharePermission -> Maybe Int
permissionVersion :: Prelude.Maybe Prelude.Int,
    -- | Specifies whether the specified permission should replace or add to the
    -- existing permission associated with the resource share. Use @true@ to
    -- replace the current permissions. Use @false@ to add the permission to
    -- the current permission. The default value is @false@.
    --
    -- A resource share can have only one permission per resource type. If a
    -- resource share already has a permission for the specified resource type
    -- and you don\'t set @replace@ to @true@ then the operation returns an
    -- error. This helps prevent accidental overwriting of a permission.
    AssociateResourceSharePermission -> Maybe Bool
replace :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
    -- of the resource share to which you want to add or replace permissions.
    AssociateResourceSharePermission -> Text
resourceShareArn :: Prelude.Text,
    -- | Specifies the
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
    -- of the RAM permission to associate with the resource share. To find the
    -- ARN for a permission, use either the ListPermissions operation or go to
    -- the
    -- <https://console.aws.amazon.com/ram/home#Permissions: Permissions library>
    -- page in the RAM console and then choose the name of the permission. The
    -- ARN is displayed on the detail page.
    AssociateResourceSharePermission -> Text
permissionArn :: Prelude.Text
  }
  deriving (AssociateResourceSharePermission
-> AssociateResourceSharePermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateResourceSharePermission
-> AssociateResourceSharePermission -> Bool
$c/= :: AssociateResourceSharePermission
-> AssociateResourceSharePermission -> Bool
== :: AssociateResourceSharePermission
-> AssociateResourceSharePermission -> Bool
$c== :: AssociateResourceSharePermission
-> AssociateResourceSharePermission -> Bool
Prelude.Eq, ReadPrec [AssociateResourceSharePermission]
ReadPrec AssociateResourceSharePermission
Int -> ReadS AssociateResourceSharePermission
ReadS [AssociateResourceSharePermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateResourceSharePermission]
$creadListPrec :: ReadPrec [AssociateResourceSharePermission]
readPrec :: ReadPrec AssociateResourceSharePermission
$creadPrec :: ReadPrec AssociateResourceSharePermission
readList :: ReadS [AssociateResourceSharePermission]
$creadList :: ReadS [AssociateResourceSharePermission]
readsPrec :: Int -> ReadS AssociateResourceSharePermission
$creadsPrec :: Int -> ReadS AssociateResourceSharePermission
Prelude.Read, Int -> AssociateResourceSharePermission -> ShowS
[AssociateResourceSharePermission] -> ShowS
AssociateResourceSharePermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateResourceSharePermission] -> ShowS
$cshowList :: [AssociateResourceSharePermission] -> ShowS
show :: AssociateResourceSharePermission -> String
$cshow :: AssociateResourceSharePermission -> String
showsPrec :: Int -> AssociateResourceSharePermission -> ShowS
$cshowsPrec :: Int -> AssociateResourceSharePermission -> ShowS
Prelude.Show, forall x.
Rep AssociateResourceSharePermission x
-> AssociateResourceSharePermission
forall x.
AssociateResourceSharePermission
-> Rep AssociateResourceSharePermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateResourceSharePermission x
-> AssociateResourceSharePermission
$cfrom :: forall x.
AssociateResourceSharePermission
-> Rep AssociateResourceSharePermission x
Prelude.Generic)

-- |
-- Create a value of 'AssociateResourceSharePermission' 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:
--
-- 'clientToken', 'associateResourceSharePermission_clientToken' - Specifies a unique, case-sensitive identifier that you provide to ensure
-- the idempotency of the request. This lets you safely retry the request
-- without accidentally performing the same operation a second time.
-- Passing the same value to a later call to an operation requires that you
-- also pass the same value for all other parameters. We recommend that you
-- use a
-- <https://wikipedia.org/wiki/Universally_unique_identifier UUID type of value.>.
--
-- If you don\'t provide this value, then Amazon Web Services generates a
-- random one for you.
--
-- 'permissionVersion', 'associateResourceSharePermission_permissionVersion' - Specifies the version of the RAM permission to associate with the
-- resource share. If you don\'t specify this parameter, the operation uses
-- the version designated as the default. You can use the
-- ListPermissionVersions operation to discover the available versions of a
-- permission.
--
-- 'replace', 'associateResourceSharePermission_replace' - Specifies whether the specified permission should replace or add to the
-- existing permission associated with the resource share. Use @true@ to
-- replace the current permissions. Use @false@ to add the permission to
-- the current permission. The default value is @false@.
--
-- A resource share can have only one permission per resource type. If a
-- resource share already has a permission for the specified resource type
-- and you don\'t set @replace@ to @true@ then the operation returns an
-- error. This helps prevent accidental overwriting of a permission.
--
-- 'resourceShareArn', 'associateResourceSharePermission_resourceShareArn' - Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
-- of the resource share to which you want to add or replace permissions.
--
-- 'permissionArn', 'associateResourceSharePermission_permissionArn' - Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
-- of the RAM permission to associate with the resource share. To find the
-- ARN for a permission, use either the ListPermissions operation or go to
-- the
-- <https://console.aws.amazon.com/ram/home#Permissions: Permissions library>
-- page in the RAM console and then choose the name of the permission. The
-- ARN is displayed on the detail page.
newAssociateResourceSharePermission ::
  -- | 'resourceShareArn'
  Prelude.Text ->
  -- | 'permissionArn'
  Prelude.Text ->
  AssociateResourceSharePermission
newAssociateResourceSharePermission :: Text -> Text -> AssociateResourceSharePermission
newAssociateResourceSharePermission
  Text
pResourceShareArn_
  Text
pPermissionArn_ =
    AssociateResourceSharePermission'
      { $sel:clientToken:AssociateResourceSharePermission' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:permissionVersion:AssociateResourceSharePermission' :: Maybe Int
permissionVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:replace:AssociateResourceSharePermission' :: Maybe Bool
replace = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceShareArn:AssociateResourceSharePermission' :: Text
resourceShareArn = Text
pResourceShareArn_,
        $sel:permissionArn:AssociateResourceSharePermission' :: Text
permissionArn = Text
pPermissionArn_
      }

-- | Specifies a unique, case-sensitive identifier that you provide to ensure
-- the idempotency of the request. This lets you safely retry the request
-- without accidentally performing the same operation a second time.
-- Passing the same value to a later call to an operation requires that you
-- also pass the same value for all other parameters. We recommend that you
-- use a
-- <https://wikipedia.org/wiki/Universally_unique_identifier UUID type of value.>.
--
-- If you don\'t provide this value, then Amazon Web Services generates a
-- random one for you.
associateResourceSharePermission_clientToken :: Lens.Lens' AssociateResourceSharePermission (Prelude.Maybe Prelude.Text)
associateResourceSharePermission_clientToken :: Lens' AssociateResourceSharePermission (Maybe Text)
associateResourceSharePermission_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermission' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: AssociateResourceSharePermission
s@AssociateResourceSharePermission' {} Maybe Text
a -> AssociateResourceSharePermission
s {$sel:clientToken:AssociateResourceSharePermission' :: Maybe Text
clientToken = Maybe Text
a} :: AssociateResourceSharePermission)

-- | Specifies the version of the RAM permission to associate with the
-- resource share. If you don\'t specify this parameter, the operation uses
-- the version designated as the default. You can use the
-- ListPermissionVersions operation to discover the available versions of a
-- permission.
associateResourceSharePermission_permissionVersion :: Lens.Lens' AssociateResourceSharePermission (Prelude.Maybe Prelude.Int)
associateResourceSharePermission_permissionVersion :: Lens' AssociateResourceSharePermission (Maybe Int)
associateResourceSharePermission_permissionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermission' {Maybe Int
permissionVersion :: Maybe Int
$sel:permissionVersion:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Int
permissionVersion} -> Maybe Int
permissionVersion) (\s :: AssociateResourceSharePermission
s@AssociateResourceSharePermission' {} Maybe Int
a -> AssociateResourceSharePermission
s {$sel:permissionVersion:AssociateResourceSharePermission' :: Maybe Int
permissionVersion = Maybe Int
a} :: AssociateResourceSharePermission)

-- | Specifies whether the specified permission should replace or add to the
-- existing permission associated with the resource share. Use @true@ to
-- replace the current permissions. Use @false@ to add the permission to
-- the current permission. The default value is @false@.
--
-- A resource share can have only one permission per resource type. If a
-- resource share already has a permission for the specified resource type
-- and you don\'t set @replace@ to @true@ then the operation returns an
-- error. This helps prevent accidental overwriting of a permission.
associateResourceSharePermission_replace :: Lens.Lens' AssociateResourceSharePermission (Prelude.Maybe Prelude.Bool)
associateResourceSharePermission_replace :: Lens' AssociateResourceSharePermission (Maybe Bool)
associateResourceSharePermission_replace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermission' {Maybe Bool
replace :: Maybe Bool
$sel:replace:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Bool
replace} -> Maybe Bool
replace) (\s :: AssociateResourceSharePermission
s@AssociateResourceSharePermission' {} Maybe Bool
a -> AssociateResourceSharePermission
s {$sel:replace:AssociateResourceSharePermission' :: Maybe Bool
replace = Maybe Bool
a} :: AssociateResourceSharePermission)

-- | Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
-- of the resource share to which you want to add or replace permissions.
associateResourceSharePermission_resourceShareArn :: Lens.Lens' AssociateResourceSharePermission Prelude.Text
associateResourceSharePermission_resourceShareArn :: Lens' AssociateResourceSharePermission Text
associateResourceSharePermission_resourceShareArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermission' {Text
resourceShareArn :: Text
$sel:resourceShareArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
resourceShareArn} -> Text
resourceShareArn) (\s :: AssociateResourceSharePermission
s@AssociateResourceSharePermission' {} Text
a -> AssociateResourceSharePermission
s {$sel:resourceShareArn:AssociateResourceSharePermission' :: Text
resourceShareArn = Text
a} :: AssociateResourceSharePermission)

-- | Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
-- of the RAM permission to associate with the resource share. To find the
-- ARN for a permission, use either the ListPermissions operation or go to
-- the
-- <https://console.aws.amazon.com/ram/home#Permissions: Permissions library>
-- page in the RAM console and then choose the name of the permission. The
-- ARN is displayed on the detail page.
associateResourceSharePermission_permissionArn :: Lens.Lens' AssociateResourceSharePermission Prelude.Text
associateResourceSharePermission_permissionArn :: Lens' AssociateResourceSharePermission Text
associateResourceSharePermission_permissionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermission' {Text
permissionArn :: Text
$sel:permissionArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
permissionArn} -> Text
permissionArn) (\s :: AssociateResourceSharePermission
s@AssociateResourceSharePermission' {} Text
a -> AssociateResourceSharePermission
s {$sel:permissionArn:AssociateResourceSharePermission' :: Text
permissionArn = Text
a} :: AssociateResourceSharePermission)

instance
  Core.AWSRequest
    AssociateResourceSharePermission
  where
  type
    AWSResponse AssociateResourceSharePermission =
      AssociateResourceSharePermissionResponse
  request :: (Service -> Service)
-> AssociateResourceSharePermission
-> Request AssociateResourceSharePermission
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 AssociateResourceSharePermission
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateResourceSharePermission)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Bool -> Int -> AssociateResourceSharePermissionResponse
AssociateResourceSharePermissionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"clientToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"returnValue")
            forall (f :: * -> *) a b. Applicative f => 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
    AssociateResourceSharePermission
  where
  hashWithSalt :: Int -> AssociateResourceSharePermission -> Int
hashWithSalt
    Int
_salt
    AssociateResourceSharePermission' {Maybe Bool
Maybe Int
Maybe Text
Text
permissionArn :: Text
resourceShareArn :: Text
replace :: Maybe Bool
permissionVersion :: Maybe Int
clientToken :: Maybe Text
$sel:permissionArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:resourceShareArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:replace:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Bool
$sel:permissionVersion:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Int
$sel:clientToken:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
permissionVersion
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
replace
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceShareArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
permissionArn

instance
  Prelude.NFData
    AssociateResourceSharePermission
  where
  rnf :: AssociateResourceSharePermission -> ()
rnf AssociateResourceSharePermission' {Maybe Bool
Maybe Int
Maybe Text
Text
permissionArn :: Text
resourceShareArn :: Text
replace :: Maybe Bool
permissionVersion :: Maybe Int
clientToken :: Maybe Text
$sel:permissionArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:resourceShareArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:replace:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Bool
$sel:permissionVersion:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Int
$sel:clientToken:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
permissionVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
replace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceShareArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
permissionArn

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

instance Data.ToJSON AssociateResourceSharePermission where
  toJSON :: AssociateResourceSharePermission -> Value
toJSON AssociateResourceSharePermission' {Maybe Bool
Maybe Int
Maybe Text
Text
permissionArn :: Text
resourceShareArn :: Text
replace :: Maybe Bool
permissionVersion :: Maybe Int
clientToken :: Maybe Text
$sel:permissionArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:resourceShareArn:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Text
$sel:replace:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Bool
$sel:permissionVersion:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Int
$sel:clientToken:AssociateResourceSharePermission' :: AssociateResourceSharePermission -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"permissionVersion" 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 Int
permissionVersion,
            (Key
"replace" 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 Bool
replace,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"resourceShareArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceShareArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"permissionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
permissionArn)
          ]
      )

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

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

-- | /See:/ 'newAssociateResourceSharePermissionResponse' smart constructor.
data AssociateResourceSharePermissionResponse = AssociateResourceSharePermissionResponse'
  { -- | The idempotency identifier associated with this request. If you want to
    -- repeat the same operation in an idempotent manner then you must include
    -- this value in the @clientToken@ request parameter of that later call.
    -- All other parameters must also have the same values that you used in the
    -- first call.
    AssociateResourceSharePermissionResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A return value of @true@ indicates that the request succeeded. A value
    -- of @false@ indicates that the request failed.
    AssociateResourceSharePermissionResponse -> Maybe Bool
returnValue :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    AssociateResourceSharePermissionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateResourceSharePermissionResponse
-> AssociateResourceSharePermissionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateResourceSharePermissionResponse
-> AssociateResourceSharePermissionResponse -> Bool
$c/= :: AssociateResourceSharePermissionResponse
-> AssociateResourceSharePermissionResponse -> Bool
== :: AssociateResourceSharePermissionResponse
-> AssociateResourceSharePermissionResponse -> Bool
$c== :: AssociateResourceSharePermissionResponse
-> AssociateResourceSharePermissionResponse -> Bool
Prelude.Eq, ReadPrec [AssociateResourceSharePermissionResponse]
ReadPrec AssociateResourceSharePermissionResponse
Int -> ReadS AssociateResourceSharePermissionResponse
ReadS [AssociateResourceSharePermissionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateResourceSharePermissionResponse]
$creadListPrec :: ReadPrec [AssociateResourceSharePermissionResponse]
readPrec :: ReadPrec AssociateResourceSharePermissionResponse
$creadPrec :: ReadPrec AssociateResourceSharePermissionResponse
readList :: ReadS [AssociateResourceSharePermissionResponse]
$creadList :: ReadS [AssociateResourceSharePermissionResponse]
readsPrec :: Int -> ReadS AssociateResourceSharePermissionResponse
$creadsPrec :: Int -> ReadS AssociateResourceSharePermissionResponse
Prelude.Read, Int -> AssociateResourceSharePermissionResponse -> ShowS
[AssociateResourceSharePermissionResponse] -> ShowS
AssociateResourceSharePermissionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateResourceSharePermissionResponse] -> ShowS
$cshowList :: [AssociateResourceSharePermissionResponse] -> ShowS
show :: AssociateResourceSharePermissionResponse -> String
$cshow :: AssociateResourceSharePermissionResponse -> String
showsPrec :: Int -> AssociateResourceSharePermissionResponse -> ShowS
$cshowsPrec :: Int -> AssociateResourceSharePermissionResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateResourceSharePermissionResponse x
-> AssociateResourceSharePermissionResponse
forall x.
AssociateResourceSharePermissionResponse
-> Rep AssociateResourceSharePermissionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateResourceSharePermissionResponse x
-> AssociateResourceSharePermissionResponse
$cfrom :: forall x.
AssociateResourceSharePermissionResponse
-> Rep AssociateResourceSharePermissionResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateResourceSharePermissionResponse' 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:
--
-- 'clientToken', 'associateResourceSharePermissionResponse_clientToken' - The idempotency identifier associated with this request. If you want to
-- repeat the same operation in an idempotent manner then you must include
-- this value in the @clientToken@ request parameter of that later call.
-- All other parameters must also have the same values that you used in the
-- first call.
--
-- 'returnValue', 'associateResourceSharePermissionResponse_returnValue' - A return value of @true@ indicates that the request succeeded. A value
-- of @false@ indicates that the request failed.
--
-- 'httpStatus', 'associateResourceSharePermissionResponse_httpStatus' - The response's http status code.
newAssociateResourceSharePermissionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateResourceSharePermissionResponse
newAssociateResourceSharePermissionResponse :: Int -> AssociateResourceSharePermissionResponse
newAssociateResourceSharePermissionResponse
  Int
pHttpStatus_ =
    AssociateResourceSharePermissionResponse'
      { $sel:clientToken:AssociateResourceSharePermissionResponse' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:returnValue:AssociateResourceSharePermissionResponse' :: Maybe Bool
returnValue = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AssociateResourceSharePermissionResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The idempotency identifier associated with this request. If you want to
-- repeat the same operation in an idempotent manner then you must include
-- this value in the @clientToken@ request parameter of that later call.
-- All other parameters must also have the same values that you used in the
-- first call.
associateResourceSharePermissionResponse_clientToken :: Lens.Lens' AssociateResourceSharePermissionResponse (Prelude.Maybe Prelude.Text)
associateResourceSharePermissionResponse_clientToken :: Lens' AssociateResourceSharePermissionResponse (Maybe Text)
associateResourceSharePermissionResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermissionResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:AssociateResourceSharePermissionResponse' :: AssociateResourceSharePermissionResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: AssociateResourceSharePermissionResponse
s@AssociateResourceSharePermissionResponse' {} Maybe Text
a -> AssociateResourceSharePermissionResponse
s {$sel:clientToken:AssociateResourceSharePermissionResponse' :: Maybe Text
clientToken = Maybe Text
a} :: AssociateResourceSharePermissionResponse)

-- | A return value of @true@ indicates that the request succeeded. A value
-- of @false@ indicates that the request failed.
associateResourceSharePermissionResponse_returnValue :: Lens.Lens' AssociateResourceSharePermissionResponse (Prelude.Maybe Prelude.Bool)
associateResourceSharePermissionResponse_returnValue :: Lens' AssociateResourceSharePermissionResponse (Maybe Bool)
associateResourceSharePermissionResponse_returnValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResourceSharePermissionResponse' {Maybe Bool
returnValue :: Maybe Bool
$sel:returnValue:AssociateResourceSharePermissionResponse' :: AssociateResourceSharePermissionResponse -> Maybe Bool
returnValue} -> Maybe Bool
returnValue) (\s :: AssociateResourceSharePermissionResponse
s@AssociateResourceSharePermissionResponse' {} Maybe Bool
a -> AssociateResourceSharePermissionResponse
s {$sel:returnValue:AssociateResourceSharePermissionResponse' :: Maybe Bool
returnValue = Maybe Bool
a} :: AssociateResourceSharePermissionResponse)

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

instance
  Prelude.NFData
    AssociateResourceSharePermissionResponse
  where
  rnf :: AssociateResourceSharePermissionResponse -> ()
rnf AssociateResourceSharePermissionResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
returnValue :: Maybe Bool
clientToken :: Maybe Text
$sel:httpStatus:AssociateResourceSharePermissionResponse' :: AssociateResourceSharePermissionResponse -> Int
$sel:returnValue:AssociateResourceSharePermissionResponse' :: AssociateResourceSharePermissionResponse -> Maybe Bool
$sel:clientToken:AssociateResourceSharePermissionResponse' :: AssociateResourceSharePermissionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
returnValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus