{-# 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.UpdatePortfolioShare
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified portfolio share. You can use this API to enable or
-- disable @TagOptions@ sharing or Principal sharing for an existing
-- portfolio share.
--
-- The portfolio share cannot be updated if the @CreatePortfolioShare@
-- operation is @IN_PROGRESS@, as the share is not available to recipient
-- entities. In this case, you must wait for the portfolio share to be
-- COMPLETED.
--
-- You must provide the @accountId@ or organization node in the input, but
-- not both.
--
-- If the portfolio is shared to both an external account and an
-- organization node, and both shares need to be updated, you must invoke
-- @UpdatePortfolioShare@ separately for each share type.
--
-- This API cannot be used for removing the portfolio share. You must use
-- @DeletePortfolioShare@ API for that action.
--
-- 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.UpdatePortfolioShare
  ( -- * Creating a Request
    UpdatePortfolioShare (..),
    newUpdatePortfolioShare,

    -- * Request Lenses
    updatePortfolioShare_acceptLanguage,
    updatePortfolioShare_accountId,
    updatePortfolioShare_organizationNode,
    updatePortfolioShare_sharePrincipals,
    updatePortfolioShare_shareTagOptions,
    updatePortfolioShare_portfolioId,

    -- * Destructuring the Response
    UpdatePortfolioShareResponse (..),
    newUpdatePortfolioShareResponse,

    -- * Response Lenses
    updatePortfolioShareResponse_portfolioShareToken,
    updatePortfolioShareResponse_status,
    updatePortfolioShareResponse_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:/ 'newUpdatePortfolioShare' smart constructor.
data UpdatePortfolioShare = UpdatePortfolioShare'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    UpdatePortfolioShare -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account Id of the recipient account. This field
    -- is required when updating an external account to account type share.
    UpdatePortfolioShare -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    UpdatePortfolioShare -> Maybe OrganizationNode
organizationNode :: Prelude.Maybe OrganizationNode,
    -- | A flag to enables or disables @Principals@ sharing in the portfolio. If
    -- this field is not provided, the current state of the @Principals@
    -- sharing on the portfolio share will not be modified.
    UpdatePortfolioShare -> Maybe Bool
sharePrincipals :: Prelude.Maybe Prelude.Bool,
    -- | Enables or disables @TagOptions@ sharing for the portfolio share. If
    -- this field is not provided, the current state of TagOptions sharing on
    -- the portfolio share will not be modified.
    UpdatePortfolioShare -> Maybe Bool
shareTagOptions :: Prelude.Maybe Prelude.Bool,
    -- | The unique identifier of the portfolio for which the share will be
    -- updated.
    UpdatePortfolioShare -> Text
portfolioId :: Prelude.Text
  }
  deriving (UpdatePortfolioShare -> UpdatePortfolioShare -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePortfolioShare -> UpdatePortfolioShare -> Bool
$c/= :: UpdatePortfolioShare -> UpdatePortfolioShare -> Bool
== :: UpdatePortfolioShare -> UpdatePortfolioShare -> Bool
$c== :: UpdatePortfolioShare -> UpdatePortfolioShare -> Bool
Prelude.Eq, ReadPrec [UpdatePortfolioShare]
ReadPrec UpdatePortfolioShare
Int -> ReadS UpdatePortfolioShare
ReadS [UpdatePortfolioShare]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePortfolioShare]
$creadListPrec :: ReadPrec [UpdatePortfolioShare]
readPrec :: ReadPrec UpdatePortfolioShare
$creadPrec :: ReadPrec UpdatePortfolioShare
readList :: ReadS [UpdatePortfolioShare]
$creadList :: ReadS [UpdatePortfolioShare]
readsPrec :: Int -> ReadS UpdatePortfolioShare
$creadsPrec :: Int -> ReadS UpdatePortfolioShare
Prelude.Read, Int -> UpdatePortfolioShare -> ShowS
[UpdatePortfolioShare] -> ShowS
UpdatePortfolioShare -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePortfolioShare] -> ShowS
$cshowList :: [UpdatePortfolioShare] -> ShowS
show :: UpdatePortfolioShare -> String
$cshow :: UpdatePortfolioShare -> String
showsPrec :: Int -> UpdatePortfolioShare -> ShowS
$cshowsPrec :: Int -> UpdatePortfolioShare -> ShowS
Prelude.Show, forall x. Rep UpdatePortfolioShare x -> UpdatePortfolioShare
forall x. UpdatePortfolioShare -> Rep UpdatePortfolioShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePortfolioShare x -> UpdatePortfolioShare
$cfrom :: forall x. UpdatePortfolioShare -> Rep UpdatePortfolioShare x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePortfolioShare' 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', 'updatePortfolioShare_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'accountId', 'updatePortfolioShare_accountId' - The Amazon Web Services account Id of the recipient account. This field
-- is required when updating an external account to account type share.
--
-- 'organizationNode', 'updatePortfolioShare_organizationNode' - Undocumented member.
--
-- 'sharePrincipals', 'updatePortfolioShare_sharePrincipals' - A flag to enables or disables @Principals@ sharing in the portfolio. If
-- this field is not provided, the current state of the @Principals@
-- sharing on the portfolio share will not be modified.
--
-- 'shareTagOptions', 'updatePortfolioShare_shareTagOptions' - Enables or disables @TagOptions@ sharing for the portfolio share. If
-- this field is not provided, the current state of TagOptions sharing on
-- the portfolio share will not be modified.
--
-- 'portfolioId', 'updatePortfolioShare_portfolioId' - The unique identifier of the portfolio for which the share will be
-- updated.
newUpdatePortfolioShare ::
  -- | 'portfolioId'
  Prelude.Text ->
  UpdatePortfolioShare
newUpdatePortfolioShare :: Text -> UpdatePortfolioShare
newUpdatePortfolioShare Text
pPortfolioId_ =
  UpdatePortfolioShare'
    { $sel:acceptLanguage:UpdatePortfolioShare' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:UpdatePortfolioShare' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationNode:UpdatePortfolioShare' :: Maybe OrganizationNode
organizationNode = forall a. Maybe a
Prelude.Nothing,
      $sel:sharePrincipals:UpdatePortfolioShare' :: Maybe Bool
sharePrincipals = forall a. Maybe a
Prelude.Nothing,
      $sel:shareTagOptions:UpdatePortfolioShare' :: Maybe Bool
shareTagOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:portfolioId:UpdatePortfolioShare' :: Text
portfolioId = Text
pPortfolioId_
    }

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

-- | The Amazon Web Services account Id of the recipient account. This field
-- is required when updating an external account to account type share.
updatePortfolioShare_accountId :: Lens.Lens' UpdatePortfolioShare (Prelude.Maybe Prelude.Text)
updatePortfolioShare_accountId :: Lens' UpdatePortfolioShare (Maybe Text)
updatePortfolioShare_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShare' {Maybe Text
accountId :: Maybe Text
$sel:accountId:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: UpdatePortfolioShare
s@UpdatePortfolioShare' {} Maybe Text
a -> UpdatePortfolioShare
s {$sel:accountId:UpdatePortfolioShare' :: Maybe Text
accountId = Maybe Text
a} :: UpdatePortfolioShare)

-- | Undocumented member.
updatePortfolioShare_organizationNode :: Lens.Lens' UpdatePortfolioShare (Prelude.Maybe OrganizationNode)
updatePortfolioShare_organizationNode :: Lens' UpdatePortfolioShare (Maybe OrganizationNode)
updatePortfolioShare_organizationNode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShare' {Maybe OrganizationNode
organizationNode :: Maybe OrganizationNode
$sel:organizationNode:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe OrganizationNode
organizationNode} -> Maybe OrganizationNode
organizationNode) (\s :: UpdatePortfolioShare
s@UpdatePortfolioShare' {} Maybe OrganizationNode
a -> UpdatePortfolioShare
s {$sel:organizationNode:UpdatePortfolioShare' :: Maybe OrganizationNode
organizationNode = Maybe OrganizationNode
a} :: UpdatePortfolioShare)

-- | A flag to enables or disables @Principals@ sharing in the portfolio. If
-- this field is not provided, the current state of the @Principals@
-- sharing on the portfolio share will not be modified.
updatePortfolioShare_sharePrincipals :: Lens.Lens' UpdatePortfolioShare (Prelude.Maybe Prelude.Bool)
updatePortfolioShare_sharePrincipals :: Lens' UpdatePortfolioShare (Maybe Bool)
updatePortfolioShare_sharePrincipals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShare' {Maybe Bool
sharePrincipals :: Maybe Bool
$sel:sharePrincipals:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
sharePrincipals} -> Maybe Bool
sharePrincipals) (\s :: UpdatePortfolioShare
s@UpdatePortfolioShare' {} Maybe Bool
a -> UpdatePortfolioShare
s {$sel:sharePrincipals:UpdatePortfolioShare' :: Maybe Bool
sharePrincipals = Maybe Bool
a} :: UpdatePortfolioShare)

-- | Enables or disables @TagOptions@ sharing for the portfolio share. If
-- this field is not provided, the current state of TagOptions sharing on
-- the portfolio share will not be modified.
updatePortfolioShare_shareTagOptions :: Lens.Lens' UpdatePortfolioShare (Prelude.Maybe Prelude.Bool)
updatePortfolioShare_shareTagOptions :: Lens' UpdatePortfolioShare (Maybe Bool)
updatePortfolioShare_shareTagOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShare' {Maybe Bool
shareTagOptions :: Maybe Bool
$sel:shareTagOptions:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
shareTagOptions} -> Maybe Bool
shareTagOptions) (\s :: UpdatePortfolioShare
s@UpdatePortfolioShare' {} Maybe Bool
a -> UpdatePortfolioShare
s {$sel:shareTagOptions:UpdatePortfolioShare' :: Maybe Bool
shareTagOptions = Maybe Bool
a} :: UpdatePortfolioShare)

-- | The unique identifier of the portfolio for which the share will be
-- updated.
updatePortfolioShare_portfolioId :: Lens.Lens' UpdatePortfolioShare Prelude.Text
updatePortfolioShare_portfolioId :: Lens' UpdatePortfolioShare Text
updatePortfolioShare_portfolioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShare' {Text
portfolioId :: Text
$sel:portfolioId:UpdatePortfolioShare' :: UpdatePortfolioShare -> Text
portfolioId} -> Text
portfolioId) (\s :: UpdatePortfolioShare
s@UpdatePortfolioShare' {} Text
a -> UpdatePortfolioShare
s {$sel:portfolioId:UpdatePortfolioShare' :: Text
portfolioId = Text
a} :: UpdatePortfolioShare)

instance Core.AWSRequest UpdatePortfolioShare where
  type
    AWSResponse UpdatePortfolioShare =
      UpdatePortfolioShareResponse
  request :: (Service -> Service)
-> UpdatePortfolioShare -> Request UpdatePortfolioShare
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 UpdatePortfolioShare
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdatePortfolioShare)))
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 ShareStatus -> Int -> UpdatePortfolioShareResponse
UpdatePortfolioShareResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            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 UpdatePortfolioShare where
  hashWithSalt :: Int -> UpdatePortfolioShare -> Int
hashWithSalt Int
_salt UpdatePortfolioShare' {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:UpdatePortfolioShare' :: UpdatePortfolioShare -> Text
$sel:shareTagOptions:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:organizationNode:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Text
$sel:acceptLanguage:UpdatePortfolioShare' :: UpdatePortfolioShare -> 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 UpdatePortfolioShare where
  rnf :: UpdatePortfolioShare -> ()
rnf UpdatePortfolioShare' {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:UpdatePortfolioShare' :: UpdatePortfolioShare -> Text
$sel:shareTagOptions:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:organizationNode:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Text
$sel:acceptLanguage:UpdatePortfolioShare' :: UpdatePortfolioShare -> 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 UpdatePortfolioShare where
  toHeaders :: UpdatePortfolioShare -> 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.UpdatePortfolioShare" ::
                          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 UpdatePortfolioShare where
  toJSON :: UpdatePortfolioShare -> Value
toJSON UpdatePortfolioShare' {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:UpdatePortfolioShare' :: UpdatePortfolioShare -> Text
$sel:shareTagOptions:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:sharePrincipals:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Bool
$sel:organizationNode:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe OrganizationNode
$sel:accountId:UpdatePortfolioShare' :: UpdatePortfolioShare -> Maybe Text
$sel:acceptLanguage:UpdatePortfolioShare' :: UpdatePortfolioShare -> 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 UpdatePortfolioShare where
  toPath :: UpdatePortfolioShare -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdatePortfolioShareResponse' smart constructor.
data UpdatePortfolioShareResponse = UpdatePortfolioShareResponse'
  { -- | The token that tracks the status of the @UpdatePortfolioShare@ operation
    -- for external account to account or organizational type sharing.
    UpdatePortfolioShareResponse -> Maybe Text
portfolioShareToken :: Prelude.Maybe Prelude.Text,
    -- | The status of @UpdatePortfolioShare@ operation. You can also obtain the
    -- operation status using @DescribePortfolioShareStatus@ API.
    UpdatePortfolioShareResponse -> Maybe ShareStatus
status :: Prelude.Maybe ShareStatus,
    -- | The response's http status code.
    UpdatePortfolioShareResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePortfolioShareResponse
-> UpdatePortfolioShareResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePortfolioShareResponse
-> UpdatePortfolioShareResponse -> Bool
$c/= :: UpdatePortfolioShareResponse
-> UpdatePortfolioShareResponse -> Bool
== :: UpdatePortfolioShareResponse
-> UpdatePortfolioShareResponse -> Bool
$c== :: UpdatePortfolioShareResponse
-> UpdatePortfolioShareResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePortfolioShareResponse]
ReadPrec UpdatePortfolioShareResponse
Int -> ReadS UpdatePortfolioShareResponse
ReadS [UpdatePortfolioShareResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePortfolioShareResponse]
$creadListPrec :: ReadPrec [UpdatePortfolioShareResponse]
readPrec :: ReadPrec UpdatePortfolioShareResponse
$creadPrec :: ReadPrec UpdatePortfolioShareResponse
readList :: ReadS [UpdatePortfolioShareResponse]
$creadList :: ReadS [UpdatePortfolioShareResponse]
readsPrec :: Int -> ReadS UpdatePortfolioShareResponse
$creadsPrec :: Int -> ReadS UpdatePortfolioShareResponse
Prelude.Read, Int -> UpdatePortfolioShareResponse -> ShowS
[UpdatePortfolioShareResponse] -> ShowS
UpdatePortfolioShareResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePortfolioShareResponse] -> ShowS
$cshowList :: [UpdatePortfolioShareResponse] -> ShowS
show :: UpdatePortfolioShareResponse -> String
$cshow :: UpdatePortfolioShareResponse -> String
showsPrec :: Int -> UpdatePortfolioShareResponse -> ShowS
$cshowsPrec :: Int -> UpdatePortfolioShareResponse -> ShowS
Prelude.Show, forall x.
Rep UpdatePortfolioShareResponse x -> UpdatePortfolioShareResponse
forall x.
UpdatePortfolioShareResponse -> Rep UpdatePortfolioShareResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePortfolioShareResponse x -> UpdatePortfolioShareResponse
$cfrom :: forall x.
UpdatePortfolioShareResponse -> Rep UpdatePortfolioShareResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePortfolioShareResponse' 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', 'updatePortfolioShareResponse_portfolioShareToken' - The token that tracks the status of the @UpdatePortfolioShare@ operation
-- for external account to account or organizational type sharing.
--
-- 'status', 'updatePortfolioShareResponse_status' - The status of @UpdatePortfolioShare@ operation. You can also obtain the
-- operation status using @DescribePortfolioShareStatus@ API.
--
-- 'httpStatus', 'updatePortfolioShareResponse_httpStatus' - The response's http status code.
newUpdatePortfolioShareResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePortfolioShareResponse
newUpdatePortfolioShareResponse :: Int -> UpdatePortfolioShareResponse
newUpdatePortfolioShareResponse Int
pHttpStatus_ =
  UpdatePortfolioShareResponse'
    { $sel:portfolioShareToken:UpdatePortfolioShareResponse' :: Maybe Text
portfolioShareToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdatePortfolioShareResponse' :: Maybe ShareStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePortfolioShareResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token that tracks the status of the @UpdatePortfolioShare@ operation
-- for external account to account or organizational type sharing.
updatePortfolioShareResponse_portfolioShareToken :: Lens.Lens' UpdatePortfolioShareResponse (Prelude.Maybe Prelude.Text)
updatePortfolioShareResponse_portfolioShareToken :: Lens' UpdatePortfolioShareResponse (Maybe Text)
updatePortfolioShareResponse_portfolioShareToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShareResponse' {Maybe Text
portfolioShareToken :: Maybe Text
$sel:portfolioShareToken:UpdatePortfolioShareResponse' :: UpdatePortfolioShareResponse -> Maybe Text
portfolioShareToken} -> Maybe Text
portfolioShareToken) (\s :: UpdatePortfolioShareResponse
s@UpdatePortfolioShareResponse' {} Maybe Text
a -> UpdatePortfolioShareResponse
s {$sel:portfolioShareToken:UpdatePortfolioShareResponse' :: Maybe Text
portfolioShareToken = Maybe Text
a} :: UpdatePortfolioShareResponse)

-- | The status of @UpdatePortfolioShare@ operation. You can also obtain the
-- operation status using @DescribePortfolioShareStatus@ API.
updatePortfolioShareResponse_status :: Lens.Lens' UpdatePortfolioShareResponse (Prelude.Maybe ShareStatus)
updatePortfolioShareResponse_status :: Lens' UpdatePortfolioShareResponse (Maybe ShareStatus)
updatePortfolioShareResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioShareResponse' {Maybe ShareStatus
status :: Maybe ShareStatus
$sel:status:UpdatePortfolioShareResponse' :: UpdatePortfolioShareResponse -> Maybe ShareStatus
status} -> Maybe ShareStatus
status) (\s :: UpdatePortfolioShareResponse
s@UpdatePortfolioShareResponse' {} Maybe ShareStatus
a -> UpdatePortfolioShareResponse
s {$sel:status:UpdatePortfolioShareResponse' :: Maybe ShareStatus
status = Maybe ShareStatus
a} :: UpdatePortfolioShareResponse)

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

instance Prelude.NFData UpdatePortfolioShareResponse where
  rnf :: UpdatePortfolioShareResponse -> ()
rnf UpdatePortfolioShareResponse' {Int
Maybe Text
Maybe ShareStatus
httpStatus :: Int
status :: Maybe ShareStatus
portfolioShareToken :: Maybe Text
$sel:httpStatus:UpdatePortfolioShareResponse' :: UpdatePortfolioShareResponse -> Int
$sel:status:UpdatePortfolioShareResponse' :: UpdatePortfolioShareResponse -> Maybe ShareStatus
$sel:portfolioShareToken:UpdatePortfolioShareResponse' :: UpdatePortfolioShareResponse -> 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 Maybe ShareStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus