{-# 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.CreateResourceShare
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a resource share. You can provide a list of the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- for the resources that you want to share, a list of principals you want
-- to share the resources with, and the permissions to grant those
-- principals.
--
-- Sharing a resource makes it available for use by principals outside of
-- the Amazon Web Services account that created the resource. Sharing
-- doesn\'t change any permissions or quotas that apply to the resource in
-- the account that created it.
module Amazonka.RAM.CreateResourceShare
  ( -- * Creating a Request
    CreateResourceShare (..),
    newCreateResourceShare,

    -- * Request Lenses
    createResourceShare_allowExternalPrincipals,
    createResourceShare_clientToken,
    createResourceShare_permissionArns,
    createResourceShare_principals,
    createResourceShare_resourceArns,
    createResourceShare_tags,
    createResourceShare_name,

    -- * Destructuring the Response
    CreateResourceShareResponse (..),
    newCreateResourceShareResponse,

    -- * Response Lenses
    createResourceShareResponse_clientToken,
    createResourceShareResponse_resourceShare,
    createResourceShareResponse_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:/ 'newCreateResourceShare' smart constructor.
data CreateResourceShare = CreateResourceShare'
  { -- | Specifies whether principals outside your organization in Organizations
    -- can be associated with a resource share. A value of @true@ lets you
    -- share with individual Amazon Web Services accounts that are /not/ in
    -- your organization. A value of @false@ only has meaning if your account
    -- is a member of an Amazon Web Services Organization. The default value is
    -- @true@.
    CreateResourceShare -> Maybe Bool
allowExternalPrincipals :: Prelude.Maybe Prelude.Bool,
    -- | 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.
    CreateResourceShare -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- of the RAM permission to associate with the resource share. If you do
    -- not specify an ARN for the permission, RAM automatically attaches the
    -- default version of the permission for each resource type. You can
    -- associate only one permission with each resource type included in the
    -- resource share.
    CreateResourceShare -> Maybe [Text]
permissionArns :: Prelude.Maybe [Prelude.Text],
    -- | Specifies a list of one or more principals to associate with the
    -- resource share.
    --
    -- You can include the following values:
    --
    -- -   An Amazon Web Services account ID, for example: @123456789012@
    --
    -- -   An
    --     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
    --     of an organization in Organizations, for example:
    --     @organizations::123456789012:organization\/o-exampleorgid@
    --
    -- -   An ARN of an organizational unit (OU) in Organizations, for example:
    --     @organizations::123456789012:ou\/o-exampleorgid\/ou-examplerootid-exampleouid123@
    --
    -- -   An ARN of an IAM role, for example:
    --     @iam::123456789012:role\/rolename@
    --
    -- -   An ARN of an IAM user, for example:
    --     @iam::123456789012user\/username@
    --
    -- Not all resource types can be shared with IAM roles and users. For more
    -- information, see
    -- <https://docs.aws.amazon.com/ram/latest/userguide/permissions.html#permissions-rbp-supported-resource-types Sharing with IAM roles and users>
    -- in the /Resource Access Manager User Guide/.
    CreateResourceShare -> Maybe [Text]
principals :: Prelude.Maybe [Prelude.Text],
    -- | Specifies a list of one or more ARNs of the resources to associate with
    -- the resource share.
    CreateResourceShare -> Maybe [Text]
resourceArns :: Prelude.Maybe [Prelude.Text],
    -- | Specifies one or more tags to attach to the resource share itself. It
    -- doesn\'t attach the tags to the resources associated with the resource
    -- share.
    CreateResourceShare -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Specifies the name of the resource share.
    CreateResourceShare -> Text
name :: Prelude.Text
  }
  deriving (CreateResourceShare -> CreateResourceShare -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateResourceShare -> CreateResourceShare -> Bool
$c/= :: CreateResourceShare -> CreateResourceShare -> Bool
== :: CreateResourceShare -> CreateResourceShare -> Bool
$c== :: CreateResourceShare -> CreateResourceShare -> Bool
Prelude.Eq, ReadPrec [CreateResourceShare]
ReadPrec CreateResourceShare
Int -> ReadS CreateResourceShare
ReadS [CreateResourceShare]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateResourceShare]
$creadListPrec :: ReadPrec [CreateResourceShare]
readPrec :: ReadPrec CreateResourceShare
$creadPrec :: ReadPrec CreateResourceShare
readList :: ReadS [CreateResourceShare]
$creadList :: ReadS [CreateResourceShare]
readsPrec :: Int -> ReadS CreateResourceShare
$creadsPrec :: Int -> ReadS CreateResourceShare
Prelude.Read, Int -> CreateResourceShare -> ShowS
[CreateResourceShare] -> ShowS
CreateResourceShare -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResourceShare] -> ShowS
$cshowList :: [CreateResourceShare] -> ShowS
show :: CreateResourceShare -> String
$cshow :: CreateResourceShare -> String
showsPrec :: Int -> CreateResourceShare -> ShowS
$cshowsPrec :: Int -> CreateResourceShare -> ShowS
Prelude.Show, forall x. Rep CreateResourceShare x -> CreateResourceShare
forall x. CreateResourceShare -> Rep CreateResourceShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateResourceShare x -> CreateResourceShare
$cfrom :: forall x. CreateResourceShare -> Rep CreateResourceShare x
Prelude.Generic)

-- |
-- Create a value of 'CreateResourceShare' 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:
--
-- 'allowExternalPrincipals', 'createResourceShare_allowExternalPrincipals' - Specifies whether principals outside your organization in Organizations
-- can be associated with a resource share. A value of @true@ lets you
-- share with individual Amazon Web Services accounts that are /not/ in
-- your organization. A value of @false@ only has meaning if your account
-- is a member of an Amazon Web Services Organization. The default value is
-- @true@.
--
-- 'clientToken', 'createResourceShare_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.
--
-- 'permissionArns', 'createResourceShare_permissionArns' - Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- of the RAM permission to associate with the resource share. If you do
-- not specify an ARN for the permission, RAM automatically attaches the
-- default version of the permission for each resource type. You can
-- associate only one permission with each resource type included in the
-- resource share.
--
-- 'principals', 'createResourceShare_principals' - Specifies a list of one or more principals to associate with the
-- resource share.
--
-- You can include the following values:
--
-- -   An Amazon Web Services account ID, for example: @123456789012@
--
-- -   An
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
--     of an organization in Organizations, for example:
--     @organizations::123456789012:organization\/o-exampleorgid@
--
-- -   An ARN of an organizational unit (OU) in Organizations, for example:
--     @organizations::123456789012:ou\/o-exampleorgid\/ou-examplerootid-exampleouid123@
--
-- -   An ARN of an IAM role, for example:
--     @iam::123456789012:role\/rolename@
--
-- -   An ARN of an IAM user, for example:
--     @iam::123456789012user\/username@
--
-- Not all resource types can be shared with IAM roles and users. For more
-- information, see
-- <https://docs.aws.amazon.com/ram/latest/userguide/permissions.html#permissions-rbp-supported-resource-types Sharing with IAM roles and users>
-- in the /Resource Access Manager User Guide/.
--
-- 'resourceArns', 'createResourceShare_resourceArns' - Specifies a list of one or more ARNs of the resources to associate with
-- the resource share.
--
-- 'tags', 'createResourceShare_tags' - Specifies one or more tags to attach to the resource share itself. It
-- doesn\'t attach the tags to the resources associated with the resource
-- share.
--
-- 'name', 'createResourceShare_name' - Specifies the name of the resource share.
newCreateResourceShare ::
  -- | 'name'
  Prelude.Text ->
  CreateResourceShare
newCreateResourceShare :: Text -> CreateResourceShare
newCreateResourceShare Text
pName_ =
  CreateResourceShare'
    { $sel:allowExternalPrincipals:CreateResourceShare' :: Maybe Bool
allowExternalPrincipals =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateResourceShare' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionArns:CreateResourceShare' :: Maybe [Text]
permissionArns = forall a. Maybe a
Prelude.Nothing,
      $sel:principals:CreateResourceShare' :: Maybe [Text]
principals = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArns:CreateResourceShare' :: Maybe [Text]
resourceArns = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateResourceShare' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateResourceShare' :: Text
name = Text
pName_
    }

-- | Specifies whether principals outside your organization in Organizations
-- can be associated with a resource share. A value of @true@ lets you
-- share with individual Amazon Web Services accounts that are /not/ in
-- your organization. A value of @false@ only has meaning if your account
-- is a member of an Amazon Web Services Organization. The default value is
-- @true@.
createResourceShare_allowExternalPrincipals :: Lens.Lens' CreateResourceShare (Prelude.Maybe Prelude.Bool)
createResourceShare_allowExternalPrincipals :: Lens' CreateResourceShare (Maybe Bool)
createResourceShare_allowExternalPrincipals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe Bool
allowExternalPrincipals :: Maybe Bool
$sel:allowExternalPrincipals:CreateResourceShare' :: CreateResourceShare -> Maybe Bool
allowExternalPrincipals} -> Maybe Bool
allowExternalPrincipals) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe Bool
a -> CreateResourceShare
s {$sel:allowExternalPrincipals:CreateResourceShare' :: Maybe Bool
allowExternalPrincipals = Maybe Bool
a} :: CreateResourceShare)

-- | 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.
createResourceShare_clientToken :: Lens.Lens' CreateResourceShare (Prelude.Maybe Prelude.Text)
createResourceShare_clientToken :: Lens' CreateResourceShare (Maybe Text)
createResourceShare_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateResourceShare' :: CreateResourceShare -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe Text
a -> CreateResourceShare
s {$sel:clientToken:CreateResourceShare' :: Maybe Text
clientToken = Maybe Text
a} :: CreateResourceShare)

-- | Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- of the RAM permission to associate with the resource share. If you do
-- not specify an ARN for the permission, RAM automatically attaches the
-- default version of the permission for each resource type. You can
-- associate only one permission with each resource type included in the
-- resource share.
createResourceShare_permissionArns :: Lens.Lens' CreateResourceShare (Prelude.Maybe [Prelude.Text])
createResourceShare_permissionArns :: Lens' CreateResourceShare (Maybe [Text])
createResourceShare_permissionArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe [Text]
permissionArns :: Maybe [Text]
$sel:permissionArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
permissionArns} -> Maybe [Text]
permissionArns) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe [Text]
a -> CreateResourceShare
s {$sel:permissionArns:CreateResourceShare' :: Maybe [Text]
permissionArns = Maybe [Text]
a} :: CreateResourceShare) 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

-- | Specifies a list of one or more principals to associate with the
-- resource share.
--
-- You can include the following values:
--
-- -   An Amazon Web Services account ID, for example: @123456789012@
--
-- -   An
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resoure Name (ARN)>
--     of an organization in Organizations, for example:
--     @organizations::123456789012:organization\/o-exampleorgid@
--
-- -   An ARN of an organizational unit (OU) in Organizations, for example:
--     @organizations::123456789012:ou\/o-exampleorgid\/ou-examplerootid-exampleouid123@
--
-- -   An ARN of an IAM role, for example:
--     @iam::123456789012:role\/rolename@
--
-- -   An ARN of an IAM user, for example:
--     @iam::123456789012user\/username@
--
-- Not all resource types can be shared with IAM roles and users. For more
-- information, see
-- <https://docs.aws.amazon.com/ram/latest/userguide/permissions.html#permissions-rbp-supported-resource-types Sharing with IAM roles and users>
-- in the /Resource Access Manager User Guide/.
createResourceShare_principals :: Lens.Lens' CreateResourceShare (Prelude.Maybe [Prelude.Text])
createResourceShare_principals :: Lens' CreateResourceShare (Maybe [Text])
createResourceShare_principals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe [Text]
principals :: Maybe [Text]
$sel:principals:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
principals} -> Maybe [Text]
principals) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe [Text]
a -> CreateResourceShare
s {$sel:principals:CreateResourceShare' :: Maybe [Text]
principals = Maybe [Text]
a} :: CreateResourceShare) 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

-- | Specifies a list of one or more ARNs of the resources to associate with
-- the resource share.
createResourceShare_resourceArns :: Lens.Lens' CreateResourceShare (Prelude.Maybe [Prelude.Text])
createResourceShare_resourceArns :: Lens' CreateResourceShare (Maybe [Text])
createResourceShare_resourceArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe [Text]
resourceArns :: Maybe [Text]
$sel:resourceArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
resourceArns} -> Maybe [Text]
resourceArns) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe [Text]
a -> CreateResourceShare
s {$sel:resourceArns:CreateResourceShare' :: Maybe [Text]
resourceArns = Maybe [Text]
a} :: CreateResourceShare) 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

-- | Specifies one or more tags to attach to the resource share itself. It
-- doesn\'t attach the tags to the resources associated with the resource
-- share.
createResourceShare_tags :: Lens.Lens' CreateResourceShare (Prelude.Maybe [Tag])
createResourceShare_tags :: Lens' CreateResourceShare (Maybe [Tag])
createResourceShare_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateResourceShare' :: CreateResourceShare -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateResourceShare
s@CreateResourceShare' {} Maybe [Tag]
a -> CreateResourceShare
s {$sel:tags:CreateResourceShare' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateResourceShare) 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

-- | Specifies the name of the resource share.
createResourceShare_name :: Lens.Lens' CreateResourceShare Prelude.Text
createResourceShare_name :: Lens' CreateResourceShare Text
createResourceShare_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShare' {Text
name :: Text
$sel:name:CreateResourceShare' :: CreateResourceShare -> Text
name} -> Text
name) (\s :: CreateResourceShare
s@CreateResourceShare' {} Text
a -> CreateResourceShare
s {$sel:name:CreateResourceShare' :: Text
name = Text
a} :: CreateResourceShare)

instance Core.AWSRequest CreateResourceShare where
  type
    AWSResponse CreateResourceShare =
      CreateResourceShareResponse
  request :: (Service -> Service)
-> CreateResourceShare -> Request CreateResourceShare
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 CreateResourceShare
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateResourceShare)))
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 ResourceShare -> Int -> CreateResourceShareResponse
CreateResourceShareResponse'
            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
"resourceShare")
            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 CreateResourceShare where
  hashWithSalt :: Int -> CreateResourceShare -> Int
hashWithSalt Int
_salt CreateResourceShare' {Maybe Bool
Maybe [Text]
Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
resourceArns :: Maybe [Text]
principals :: Maybe [Text]
permissionArns :: Maybe [Text]
clientToken :: Maybe Text
allowExternalPrincipals :: Maybe Bool
$sel:name:CreateResourceShare' :: CreateResourceShare -> Text
$sel:tags:CreateResourceShare' :: CreateResourceShare -> Maybe [Tag]
$sel:resourceArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:principals:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:permissionArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:clientToken:CreateResourceShare' :: CreateResourceShare -> Maybe Text
$sel:allowExternalPrincipals:CreateResourceShare' :: CreateResourceShare -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowExternalPrincipals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
permissionArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
principals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
resourceArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateResourceShare where
  rnf :: CreateResourceShare -> ()
rnf CreateResourceShare' {Maybe Bool
Maybe [Text]
Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
resourceArns :: Maybe [Text]
principals :: Maybe [Text]
permissionArns :: Maybe [Text]
clientToken :: Maybe Text
allowExternalPrincipals :: Maybe Bool
$sel:name:CreateResourceShare' :: CreateResourceShare -> Text
$sel:tags:CreateResourceShare' :: CreateResourceShare -> Maybe [Tag]
$sel:resourceArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:principals:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:permissionArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:clientToken:CreateResourceShare' :: CreateResourceShare -> Maybe Text
$sel:allowExternalPrincipals:CreateResourceShare' :: CreateResourceShare -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowExternalPrincipals
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Text]
permissionArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
principals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
resourceArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateResourceShare where
  toHeaders :: CreateResourceShare -> 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 CreateResourceShare where
  toJSON :: CreateResourceShare -> Value
toJSON CreateResourceShare' {Maybe Bool
Maybe [Text]
Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
resourceArns :: Maybe [Text]
principals :: Maybe [Text]
permissionArns :: Maybe [Text]
clientToken :: Maybe Text
allowExternalPrincipals :: Maybe Bool
$sel:name:CreateResourceShare' :: CreateResourceShare -> Text
$sel:tags:CreateResourceShare' :: CreateResourceShare -> Maybe [Tag]
$sel:resourceArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:principals:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:permissionArns:CreateResourceShare' :: CreateResourceShare -> Maybe [Text]
$sel:clientToken:CreateResourceShare' :: CreateResourceShare -> Maybe Text
$sel:allowExternalPrincipals:CreateResourceShare' :: CreateResourceShare -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"allowExternalPrincipals" 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
allowExternalPrincipals,
            (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
"permissionArns" 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]
permissionArns,
            (Key
"principals" 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]
principals,
            (Key
"resourceArns" 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]
resourceArns,
            (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateResourceShareResponse' smart constructor.
data CreateResourceShareResponse = CreateResourceShareResponse'
  { -- | 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.
    CreateResourceShareResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | An object with information about the new resource share.
    CreateResourceShareResponse -> Maybe ResourceShare
resourceShare :: Prelude.Maybe ResourceShare,
    -- | The response's http status code.
    CreateResourceShareResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateResourceShareResponse -> CreateResourceShareResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateResourceShareResponse -> CreateResourceShareResponse -> Bool
$c/= :: CreateResourceShareResponse -> CreateResourceShareResponse -> Bool
== :: CreateResourceShareResponse -> CreateResourceShareResponse -> Bool
$c== :: CreateResourceShareResponse -> CreateResourceShareResponse -> Bool
Prelude.Eq, ReadPrec [CreateResourceShareResponse]
ReadPrec CreateResourceShareResponse
Int -> ReadS CreateResourceShareResponse
ReadS [CreateResourceShareResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateResourceShareResponse]
$creadListPrec :: ReadPrec [CreateResourceShareResponse]
readPrec :: ReadPrec CreateResourceShareResponse
$creadPrec :: ReadPrec CreateResourceShareResponse
readList :: ReadS [CreateResourceShareResponse]
$creadList :: ReadS [CreateResourceShareResponse]
readsPrec :: Int -> ReadS CreateResourceShareResponse
$creadsPrec :: Int -> ReadS CreateResourceShareResponse
Prelude.Read, Int -> CreateResourceShareResponse -> ShowS
[CreateResourceShareResponse] -> ShowS
CreateResourceShareResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResourceShareResponse] -> ShowS
$cshowList :: [CreateResourceShareResponse] -> ShowS
show :: CreateResourceShareResponse -> String
$cshow :: CreateResourceShareResponse -> String
showsPrec :: Int -> CreateResourceShareResponse -> ShowS
$cshowsPrec :: Int -> CreateResourceShareResponse -> ShowS
Prelude.Show, forall x.
Rep CreateResourceShareResponse x -> CreateResourceShareResponse
forall x.
CreateResourceShareResponse -> Rep CreateResourceShareResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateResourceShareResponse x -> CreateResourceShareResponse
$cfrom :: forall x.
CreateResourceShareResponse -> Rep CreateResourceShareResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateResourceShareResponse' 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', 'createResourceShareResponse_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.
--
-- 'resourceShare', 'createResourceShareResponse_resourceShare' - An object with information about the new resource share.
--
-- 'httpStatus', 'createResourceShareResponse_httpStatus' - The response's http status code.
newCreateResourceShareResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateResourceShareResponse
newCreateResourceShareResponse :: Int -> CreateResourceShareResponse
newCreateResourceShareResponse Int
pHttpStatus_ =
  CreateResourceShareResponse'
    { $sel:clientToken:CreateResourceShareResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceShare:CreateResourceShareResponse' :: Maybe ResourceShare
resourceShare = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateResourceShareResponse' :: 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.
createResourceShareResponse_clientToken :: Lens.Lens' CreateResourceShareResponse (Prelude.Maybe Prelude.Text)
createResourceShareResponse_clientToken :: Lens' CreateResourceShareResponse (Maybe Text)
createResourceShareResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShareResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateResourceShareResponse' :: CreateResourceShareResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateResourceShareResponse
s@CreateResourceShareResponse' {} Maybe Text
a -> CreateResourceShareResponse
s {$sel:clientToken:CreateResourceShareResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateResourceShareResponse)

-- | An object with information about the new resource share.
createResourceShareResponse_resourceShare :: Lens.Lens' CreateResourceShareResponse (Prelude.Maybe ResourceShare)
createResourceShareResponse_resourceShare :: Lens' CreateResourceShareResponse (Maybe ResourceShare)
createResourceShareResponse_resourceShare = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceShareResponse' {Maybe ResourceShare
resourceShare :: Maybe ResourceShare
$sel:resourceShare:CreateResourceShareResponse' :: CreateResourceShareResponse -> Maybe ResourceShare
resourceShare} -> Maybe ResourceShare
resourceShare) (\s :: CreateResourceShareResponse
s@CreateResourceShareResponse' {} Maybe ResourceShare
a -> CreateResourceShareResponse
s {$sel:resourceShare:CreateResourceShareResponse' :: Maybe ResourceShare
resourceShare = Maybe ResourceShare
a} :: CreateResourceShareResponse)

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

instance Prelude.NFData CreateResourceShareResponse where
  rnf :: CreateResourceShareResponse -> ()
rnf CreateResourceShareResponse' {Int
Maybe Text
Maybe ResourceShare
httpStatus :: Int
resourceShare :: Maybe ResourceShare
clientToken :: Maybe Text
$sel:httpStatus:CreateResourceShareResponse' :: CreateResourceShareResponse -> Int
$sel:resourceShare:CreateResourceShareResponse' :: CreateResourceShareResponse -> Maybe ResourceShare
$sel:clientToken:CreateResourceShareResponse' :: CreateResourceShareResponse -> 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 ResourceShare
resourceShare
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus