{-# 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.ServiceCatalog.CreatePortfolioShare
-- 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 the specified portfolio with the specified account or
-- organization node. Shares to an organization node can only be created by
-- the management account of an organization or by a delegated
-- administrator. You can share portfolios to an organization, an
-- organizational unit, or a specific account.
--
-- Note that if a delegated admin is de-registered, they can no longer
-- create portfolio shares.
--
-- @AWSOrganizationsAccess@ must be enabled in order to create a portfolio
-- share to an organization node.
--
-- You can\'t share a shared resource, including portfolios that contain a
-- shared product.
--
-- If the portfolio share with the specified account or organization node
-- already exists, this action will have no effect and will not return an
-- error. To update an existing share, you must use the
-- @ UpdatePortfolioShare@ API instead.
--
-- When you associate a principal with portfolio, a potential privilege
-- escalation path may occur when that portfolio is then shared with other
-- accounts. For a user in a recipient account who is /not/ an Service
-- Catalog Admin, but still has the ability to create Principals
-- (Users\/Groups\/Roles), that user could create a role that matches a
-- principal name association for the portfolio. Although this user may not
-- know which principal names are associated through Service Catalog, they
-- may be able to guess the user. If this potential escalation path is a
-- concern, then Service Catalog recommends using @PrincipalType@ as @IAM@.
-- With this configuration, the @PrincipalARN@ must already exist in the
-- recipient account before it can be associated.
module Amazonka.ServiceCatalog.CreatePortfolioShare
  ( -- * Creating a Request
    CreatePortfolioShare (..),
    newCreatePortfolioShare,

    -- * Request Lenses
    createPortfolioShare_acceptLanguage,
    createPortfolioShare_accountId,
    createPortfolioShare_organizationNode,
    createPortfolioShare_sharePrincipals,
    createPortfolioShare_shareTagOptions,
    createPortfolioShare_portfolioId,

    -- * Destructuring the Response
    CreatePortfolioShareResponse (..),
    newCreatePortfolioShareResponse,

    -- * Response Lenses
    createPortfolioShareResponse_portfolioShareToken,
    createPortfolioShareResponse_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.ServiceCatalog.Types

-- | /See:/ 'newCreatePortfolioShare' smart constructor.
data CreatePortfolioShare = CreatePortfolioShare'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    CreatePortfolioShare -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID. For example, @123456789012@.
    CreatePortfolioShare -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | The organization node to whom you are going to share. When you pass
    -- @OrganizationNode@, it creates @PortfolioShare@ for all of the Amazon
    -- Web Services accounts that are associated to the @OrganizationNode@. The
    -- output returns a @PortfolioShareToken@, which enables the administrator
    -- to monitor the status of the @PortfolioShare@ creation process.
    CreatePortfolioShare -> Maybe OrganizationNode
organizationNode :: Prelude.Maybe OrganizationNode,
    -- | Enables or disables @Principal@ sharing when creating the portfolio
    -- share. If this flag is not provided, principal sharing is disabled.
    --
    -- When you enable Principal Name Sharing for a portfolio share, the share
    -- recipient account end users with a principal that matches any of the
    -- associated IAM patterns can provision products from the portfolio. Once
    -- shared, the share recipient can view associations of @PrincipalType@:
    -- @IAM_PATTERN@ on their portfolio. You can create the principals in the
    -- recipient account before or after creating the share.
    CreatePortfolioShare -> Maybe Bool
sharePrincipals :: Prelude.Maybe Prelude.Bool,
    -- | Enables or disables @TagOptions @ sharing when creating the portfolio
    -- share. If this flag is not provided, TagOptions sharing is disabled.
    CreatePortfolioShare -> Maybe Bool
shareTagOptions :: Prelude.Maybe Prelude.Bool,
    -- | The portfolio identifier.
    CreatePortfolioShare -> Text
portfolioId :: Prelude.Text
  }
  deriving (CreatePortfolioShare -> CreatePortfolioShare -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePortfolioShare -> CreatePortfolioShare -> Bool
$c/= :: CreatePortfolioShare -> CreatePortfolioShare -> Bool
== :: CreatePortfolioShare -> CreatePortfolioShare -> Bool
$c== :: CreatePortfolioShare -> CreatePortfolioShare -> Bool
Prelude.Eq, ReadPrec [CreatePortfolioShare]
ReadPrec CreatePortfolioShare
Int -> ReadS CreatePortfolioShare
ReadS [CreatePortfolioShare]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePortfolioShare]
$creadListPrec :: ReadPrec [CreatePortfolioShare]
readPrec :: ReadPrec CreatePortfolioShare
$creadPrec :: ReadPrec CreatePortfolioShare
readList :: ReadS [CreatePortfolioShare]
$creadList :: ReadS [CreatePortfolioShare]
readsPrec :: Int -> ReadS CreatePortfolioShare
$creadsPrec :: Int -> ReadS CreatePortfolioShare
Prelude.Read, Int -> CreatePortfolioShare -> ShowS
[CreatePortfolioShare] -> ShowS
CreatePortfolioShare -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePortfolioShare] -> ShowS
$cshowList :: [CreatePortfolioShare] -> ShowS
show :: CreatePortfolioShare -> String
$cshow :: CreatePortfolioShare -> String
showsPrec :: Int -> CreatePortfolioShare -> ShowS
$cshowsPrec :: Int -> CreatePortfolioShare -> ShowS
Prelude.Show, forall x. Rep CreatePortfolioShare x -> CreatePortfolioShare
forall x. CreatePortfolioShare -> Rep CreatePortfolioShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePortfolioShare x -> CreatePortfolioShare
$cfrom :: forall x. CreatePortfolioShare -> Rep CreatePortfolioShare x
Prelude.Generic)

-- |
-- Create a value of 'CreatePortfolioShare' 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:
--
-- 'acceptLanguage', 'createPortfolioShare_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'accountId', 'createPortfolioShare_accountId' - The Amazon Web Services account ID. For example, @123456789012@.
--
-- 'organizationNode', 'createPortfolioShare_organizationNode' - The organization node to whom you are going to share. When you pass
-- @OrganizationNode@, it creates @PortfolioShare@ for all of the Amazon
-- Web Services accounts that are associated to the @OrganizationNode@. The
-- output returns a @PortfolioShareToken@, which enables the administrator
-- to monitor the status of the @PortfolioShare@ creation process.
--
-- 'sharePrincipals', 'createPortfolioShare_sharePrincipals' - Enables or disables @Principal@ sharing when creating the portfolio
-- share. If this flag is not provided, principal sharing is disabled.
--
-- When you enable Principal Name Sharing for a portfolio share, the share
-- recipient account end users with a principal that matches any of the
-- associated IAM patterns can provision products from the portfolio. Once
-- shared, the share recipient can view associations of @PrincipalType@:
-- @IAM_PATTERN@ on their portfolio. You can create the principals in the
-- recipient account before or after creating the share.
--
-- 'shareTagOptions', 'createPortfolioShare_shareTagOptions' - Enables or disables @TagOptions @ sharing when creating the portfolio
-- share. If this flag is not provided, TagOptions sharing is disabled.
--
-- 'portfolioId', 'createPortfolioShare_portfolioId' - The portfolio identifier.
newCreatePortfolioShare ::
  -- | 'portfolioId'
  Prelude.Text ->
  CreatePortfolioShare
newCreatePortfolioShare :: Text -> CreatePortfolioShare
newCreatePortfolioShare Text
pPortfolioId_ =
  CreatePortfolioShare'
    { $sel:acceptLanguage:CreatePortfolioShare' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:CreatePortfolioShare' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationNode:CreatePortfolioShare' :: Maybe OrganizationNode
organizationNode = forall a. Maybe a
Prelude.Nothing,
      $sel:sharePrincipals:CreatePortfolioShare' :: Maybe Bool
sharePrincipals = forall a. Maybe a
Prelude.Nothing,
      $sel:shareTagOptions:CreatePortfolioShare' :: Maybe Bool
shareTagOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:portfolioId:CreatePortfolioShare' :: Text
portfolioId = Text
pPortfolioId_
    }

-- | The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
createPortfolioShare_acceptLanguage :: Lens.Lens' CreatePortfolioShare (Prelude.Maybe Prelude.Text)
createPortfolioShare_acceptLanguage :: Lens' CreatePortfolioShare (Maybe Text)
createPortfolioShare_acceptLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Maybe Text
acceptLanguage :: Maybe Text
$sel:acceptLanguage:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
acceptLanguage} -> Maybe Text
acceptLanguage) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Maybe Text
a -> CreatePortfolioShare
s {$sel:acceptLanguage:CreatePortfolioShare' :: Maybe Text
acceptLanguage = Maybe Text
a} :: CreatePortfolioShare)

-- | The Amazon Web Services account ID. For example, @123456789012@.
createPortfolioShare_accountId :: Lens.Lens' CreatePortfolioShare (Prelude.Maybe Prelude.Text)
createPortfolioShare_accountId :: Lens' CreatePortfolioShare (Maybe Text)
createPortfolioShare_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Maybe Text
accountId :: Maybe Text
$sel:accountId:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Maybe Text
a -> CreatePortfolioShare
s {$sel:accountId:CreatePortfolioShare' :: Maybe Text
accountId = Maybe Text
a} :: CreatePortfolioShare)

-- | The organization node to whom you are going to share. When you pass
-- @OrganizationNode@, it creates @PortfolioShare@ for all of the Amazon
-- Web Services accounts that are associated to the @OrganizationNode@. The
-- output returns a @PortfolioShareToken@, which enables the administrator
-- to monitor the status of the @PortfolioShare@ creation process.
createPortfolioShare_organizationNode :: Lens.Lens' CreatePortfolioShare (Prelude.Maybe OrganizationNode)
createPortfolioShare_organizationNode :: Lens' CreatePortfolioShare (Maybe OrganizationNode)
createPortfolioShare_organizationNode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Maybe OrganizationNode
organizationNode :: Maybe OrganizationNode
$sel:organizationNode:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe OrganizationNode
organizationNode} -> Maybe OrganizationNode
organizationNode) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Maybe OrganizationNode
a -> CreatePortfolioShare
s {$sel:organizationNode:CreatePortfolioShare' :: Maybe OrganizationNode
organizationNode = Maybe OrganizationNode
a} :: CreatePortfolioShare)

-- | Enables or disables @Principal@ sharing when creating the portfolio
-- share. If this flag is not provided, principal sharing is disabled.
--
-- When you enable Principal Name Sharing for a portfolio share, the share
-- recipient account end users with a principal that matches any of the
-- associated IAM patterns can provision products from the portfolio. Once
-- shared, the share recipient can view associations of @PrincipalType@:
-- @IAM_PATTERN@ on their portfolio. You can create the principals in the
-- recipient account before or after creating the share.
createPortfolioShare_sharePrincipals :: Lens.Lens' CreatePortfolioShare (Prelude.Maybe Prelude.Bool)
createPortfolioShare_sharePrincipals :: Lens' CreatePortfolioShare (Maybe Bool)
createPortfolioShare_sharePrincipals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Maybe Bool
sharePrincipals :: Maybe Bool
$sel:sharePrincipals:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
sharePrincipals} -> Maybe Bool
sharePrincipals) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Maybe Bool
a -> CreatePortfolioShare
s {$sel:sharePrincipals:CreatePortfolioShare' :: Maybe Bool
sharePrincipals = Maybe Bool
a} :: CreatePortfolioShare)

-- | Enables or disables @TagOptions @ sharing when creating the portfolio
-- share. If this flag is not provided, TagOptions sharing is disabled.
createPortfolioShare_shareTagOptions :: Lens.Lens' CreatePortfolioShare (Prelude.Maybe Prelude.Bool)
createPortfolioShare_shareTagOptions :: Lens' CreatePortfolioShare (Maybe Bool)
createPortfolioShare_shareTagOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Maybe Bool
shareTagOptions :: Maybe Bool
$sel:shareTagOptions:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
shareTagOptions} -> Maybe Bool
shareTagOptions) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Maybe Bool
a -> CreatePortfolioShare
s {$sel:shareTagOptions:CreatePortfolioShare' :: Maybe Bool
shareTagOptions = Maybe Bool
a} :: CreatePortfolioShare)

-- | The portfolio identifier.
createPortfolioShare_portfolioId :: Lens.Lens' CreatePortfolioShare Prelude.Text
createPortfolioShare_portfolioId :: Lens' CreatePortfolioShare Text
createPortfolioShare_portfolioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShare' {Text
portfolioId :: Text
$sel:portfolioId:CreatePortfolioShare' :: CreatePortfolioShare -> Text
portfolioId} -> Text
portfolioId) (\s :: CreatePortfolioShare
s@CreatePortfolioShare' {} Text
a -> CreatePortfolioShare
s {$sel:portfolioId:CreatePortfolioShare' :: Text
portfolioId = Text
a} :: CreatePortfolioShare)

instance Core.AWSRequest CreatePortfolioShare where
  type
    AWSResponse CreatePortfolioShare =
      CreatePortfolioShareResponse
  request :: (Service -> Service)
-> CreatePortfolioShare -> Request CreatePortfolioShare
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 CreatePortfolioShare
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePortfolioShare)))
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 -> Int -> CreatePortfolioShareResponse
CreatePortfolioShareResponse'
            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
"PortfolioShareToken")
            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 CreatePortfolioShare where
  hashWithSalt :: Int -> CreatePortfolioShare -> Int
hashWithSalt Int
_salt CreatePortfolioShare' {Maybe Bool
Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
shareTagOptions :: Maybe Bool
sharePrincipals :: Maybe Bool
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:CreatePortfolioShare' :: CreatePortfolioShare -> Text
$sel:shareTagOptions:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:organizationNode:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
$sel:acceptLanguage:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
acceptLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationNode
organizationNode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
sharePrincipals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
shareTagOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portfolioId

instance Prelude.NFData CreatePortfolioShare where
  rnf :: CreatePortfolioShare -> ()
rnf CreatePortfolioShare' {Maybe Bool
Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
shareTagOptions :: Maybe Bool
sharePrincipals :: Maybe Bool
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:CreatePortfolioShare' :: CreatePortfolioShare -> Text
$sel:shareTagOptions:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:organizationNode:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
$sel:acceptLanguage:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
acceptLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationNode
organizationNode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
sharePrincipals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
shareTagOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portfolioId

instance Data.ToHeaders CreatePortfolioShare where
  toHeaders :: CreatePortfolioShare -> 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
"AWS242ServiceCatalogService.CreatePortfolioShare" ::
                          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 CreatePortfolioShare where
  toJSON :: CreatePortfolioShare -> Value
toJSON CreatePortfolioShare' {Maybe Bool
Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
shareTagOptions :: Maybe Bool
sharePrincipals :: Maybe Bool
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:CreatePortfolioShare' :: CreatePortfolioShare -> Text
$sel:shareTagOptions:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Bool
$sel:organizationNode:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
$sel:acceptLanguage:CreatePortfolioShare' :: CreatePortfolioShare -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptLanguage" 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
acceptLanguage,
            (Key
"AccountId" 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
accountId,
            (Key
"OrganizationNode" 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 OrganizationNode
organizationNode,
            (Key
"SharePrincipals" 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
sharePrincipals,
            (Key
"ShareTagOptions" 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
shareTagOptions,
            forall a. a -> Maybe a
Prelude.Just (Key
"PortfolioId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
portfolioId)
          ]
      )

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

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

-- | /See:/ 'newCreatePortfolioShareResponse' smart constructor.
data CreatePortfolioShareResponse = CreatePortfolioShareResponse'
  { -- | The portfolio shares a unique identifier that only returns if the
    -- portfolio is shared to an organization node.
    CreatePortfolioShareResponse -> Maybe Text
portfolioShareToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreatePortfolioShareResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePortfolioShareResponse
-> CreatePortfolioShareResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePortfolioShareResponse
-> CreatePortfolioShareResponse -> Bool
$c/= :: CreatePortfolioShareResponse
-> CreatePortfolioShareResponse -> Bool
== :: CreatePortfolioShareResponse
-> CreatePortfolioShareResponse -> Bool
$c== :: CreatePortfolioShareResponse
-> CreatePortfolioShareResponse -> Bool
Prelude.Eq, ReadPrec [CreatePortfolioShareResponse]
ReadPrec CreatePortfolioShareResponse
Int -> ReadS CreatePortfolioShareResponse
ReadS [CreatePortfolioShareResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePortfolioShareResponse]
$creadListPrec :: ReadPrec [CreatePortfolioShareResponse]
readPrec :: ReadPrec CreatePortfolioShareResponse
$creadPrec :: ReadPrec CreatePortfolioShareResponse
readList :: ReadS [CreatePortfolioShareResponse]
$creadList :: ReadS [CreatePortfolioShareResponse]
readsPrec :: Int -> ReadS CreatePortfolioShareResponse
$creadsPrec :: Int -> ReadS CreatePortfolioShareResponse
Prelude.Read, Int -> CreatePortfolioShareResponse -> ShowS
[CreatePortfolioShareResponse] -> ShowS
CreatePortfolioShareResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePortfolioShareResponse] -> ShowS
$cshowList :: [CreatePortfolioShareResponse] -> ShowS
show :: CreatePortfolioShareResponse -> String
$cshow :: CreatePortfolioShareResponse -> String
showsPrec :: Int -> CreatePortfolioShareResponse -> ShowS
$cshowsPrec :: Int -> CreatePortfolioShareResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePortfolioShareResponse x -> CreatePortfolioShareResponse
forall x.
CreatePortfolioShareResponse -> Rep CreatePortfolioShareResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePortfolioShareResponse x -> CreatePortfolioShareResponse
$cfrom :: forall x.
CreatePortfolioShareResponse -> Rep CreatePortfolioShareResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePortfolioShareResponse' 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:
--
-- 'portfolioShareToken', 'createPortfolioShareResponse_portfolioShareToken' - The portfolio shares a unique identifier that only returns if the
-- portfolio is shared to an organization node.
--
-- 'httpStatus', 'createPortfolioShareResponse_httpStatus' - The response's http status code.
newCreatePortfolioShareResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePortfolioShareResponse
newCreatePortfolioShareResponse :: Int -> CreatePortfolioShareResponse
newCreatePortfolioShareResponse Int
pHttpStatus_ =
  CreatePortfolioShareResponse'
    { $sel:portfolioShareToken:CreatePortfolioShareResponse' :: Maybe Text
portfolioShareToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePortfolioShareResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The portfolio shares a unique identifier that only returns if the
-- portfolio is shared to an organization node.
createPortfolioShareResponse_portfolioShareToken :: Lens.Lens' CreatePortfolioShareResponse (Prelude.Maybe Prelude.Text)
createPortfolioShareResponse_portfolioShareToken :: Lens' CreatePortfolioShareResponse (Maybe Text)
createPortfolioShareResponse_portfolioShareToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortfolioShareResponse' {Maybe Text
portfolioShareToken :: Maybe Text
$sel:portfolioShareToken:CreatePortfolioShareResponse' :: CreatePortfolioShareResponse -> Maybe Text
portfolioShareToken} -> Maybe Text
portfolioShareToken) (\s :: CreatePortfolioShareResponse
s@CreatePortfolioShareResponse' {} Maybe Text
a -> CreatePortfolioShareResponse
s {$sel:portfolioShareToken:CreatePortfolioShareResponse' :: Maybe Text
portfolioShareToken = Maybe Text
a} :: CreatePortfolioShareResponse)

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

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