{-# 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.DeletePortfolioShare
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops sharing the specified portfolio with the specified account or
-- organization node. Shares to an organization node can only be deleted by
-- the management account of an organization or by a delegated
-- administrator.
--
-- Note that if a delegated admin is de-registered, portfolio shares
-- created from that account are removed.
module Amazonka.ServiceCatalog.DeletePortfolioShare
  ( -- * Creating a Request
    DeletePortfolioShare (..),
    newDeletePortfolioShare,

    -- * Request Lenses
    deletePortfolioShare_acceptLanguage,
    deletePortfolioShare_accountId,
    deletePortfolioShare_organizationNode,
    deletePortfolioShare_portfolioId,

    -- * Destructuring the Response
    DeletePortfolioShareResponse (..),
    newDeletePortfolioShareResponse,

    -- * Response Lenses
    deletePortfolioShareResponse_portfolioShareToken,
    deletePortfolioShareResponse_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:/ 'newDeletePortfolioShare' smart constructor.
data DeletePortfolioShare = DeletePortfolioShare'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    DeletePortfolioShare -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID.
    DeletePortfolioShare -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | The organization node to whom you are going to stop sharing.
    DeletePortfolioShare -> Maybe OrganizationNode
organizationNode :: Prelude.Maybe OrganizationNode,
    -- | The portfolio identifier.
    DeletePortfolioShare -> Text
portfolioId :: Prelude.Text
  }
  deriving (DeletePortfolioShare -> DeletePortfolioShare -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePortfolioShare -> DeletePortfolioShare -> Bool
$c/= :: DeletePortfolioShare -> DeletePortfolioShare -> Bool
== :: DeletePortfolioShare -> DeletePortfolioShare -> Bool
$c== :: DeletePortfolioShare -> DeletePortfolioShare -> Bool
Prelude.Eq, ReadPrec [DeletePortfolioShare]
ReadPrec DeletePortfolioShare
Int -> ReadS DeletePortfolioShare
ReadS [DeletePortfolioShare]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePortfolioShare]
$creadListPrec :: ReadPrec [DeletePortfolioShare]
readPrec :: ReadPrec DeletePortfolioShare
$creadPrec :: ReadPrec DeletePortfolioShare
readList :: ReadS [DeletePortfolioShare]
$creadList :: ReadS [DeletePortfolioShare]
readsPrec :: Int -> ReadS DeletePortfolioShare
$creadsPrec :: Int -> ReadS DeletePortfolioShare
Prelude.Read, Int -> DeletePortfolioShare -> ShowS
[DeletePortfolioShare] -> ShowS
DeletePortfolioShare -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePortfolioShare] -> ShowS
$cshowList :: [DeletePortfolioShare] -> ShowS
show :: DeletePortfolioShare -> String
$cshow :: DeletePortfolioShare -> String
showsPrec :: Int -> DeletePortfolioShare -> ShowS
$cshowsPrec :: Int -> DeletePortfolioShare -> ShowS
Prelude.Show, forall x. Rep DeletePortfolioShare x -> DeletePortfolioShare
forall x. DeletePortfolioShare -> Rep DeletePortfolioShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePortfolioShare x -> DeletePortfolioShare
$cfrom :: forall x. DeletePortfolioShare -> Rep DeletePortfolioShare x
Prelude.Generic)

-- |
-- Create a value of 'DeletePortfolioShare' 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', 'deletePortfolioShare_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'accountId', 'deletePortfolioShare_accountId' - The Amazon Web Services account ID.
--
-- 'organizationNode', 'deletePortfolioShare_organizationNode' - The organization node to whom you are going to stop sharing.
--
-- 'portfolioId', 'deletePortfolioShare_portfolioId' - The portfolio identifier.
newDeletePortfolioShare ::
  -- | 'portfolioId'
  Prelude.Text ->
  DeletePortfolioShare
newDeletePortfolioShare :: Text -> DeletePortfolioShare
newDeletePortfolioShare Text
pPortfolioId_ =
  DeletePortfolioShare'
    { $sel:acceptLanguage:DeletePortfolioShare' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:DeletePortfolioShare' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationNode:DeletePortfolioShare' :: Maybe OrganizationNode
organizationNode = forall a. Maybe a
Prelude.Nothing,
      $sel:portfolioId:DeletePortfolioShare' :: Text
portfolioId = Text
pPortfolioId_
    }

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

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

-- | The organization node to whom you are going to stop sharing.
deletePortfolioShare_organizationNode :: Lens.Lens' DeletePortfolioShare (Prelude.Maybe OrganizationNode)
deletePortfolioShare_organizationNode :: Lens' DeletePortfolioShare (Maybe OrganizationNode)
deletePortfolioShare_organizationNode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePortfolioShare' {Maybe OrganizationNode
organizationNode :: Maybe OrganizationNode
$sel:organizationNode:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe OrganizationNode
organizationNode} -> Maybe OrganizationNode
organizationNode) (\s :: DeletePortfolioShare
s@DeletePortfolioShare' {} Maybe OrganizationNode
a -> DeletePortfolioShare
s {$sel:organizationNode:DeletePortfolioShare' :: Maybe OrganizationNode
organizationNode = Maybe OrganizationNode
a} :: DeletePortfolioShare)

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

instance Core.AWSRequest DeletePortfolioShare where
  type
    AWSResponse DeletePortfolioShare =
      DeletePortfolioShareResponse
  request :: (Service -> Service)
-> DeletePortfolioShare -> Request DeletePortfolioShare
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 DeletePortfolioShare
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeletePortfolioShare)))
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 -> DeletePortfolioShareResponse
DeletePortfolioShareResponse'
            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 DeletePortfolioShare where
  hashWithSalt :: Int -> DeletePortfolioShare -> Int
hashWithSalt Int
_salt DeletePortfolioShare' {Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:DeletePortfolioShare' :: DeletePortfolioShare -> Text
$sel:organizationNode:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe OrganizationNode
$sel:accountId:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe Text
$sel:acceptLanguage:DeletePortfolioShare' :: DeletePortfolioShare -> 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` Text
portfolioId

instance Prelude.NFData DeletePortfolioShare where
  rnf :: DeletePortfolioShare -> ()
rnf DeletePortfolioShare' {Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:DeletePortfolioShare' :: DeletePortfolioShare -> Text
$sel:organizationNode:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe OrganizationNode
$sel:accountId:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe Text
$sel:acceptLanguage:DeletePortfolioShare' :: DeletePortfolioShare -> 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 Text
portfolioId

instance Data.ToHeaders DeletePortfolioShare where
  toHeaders :: DeletePortfolioShare -> 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.DeletePortfolioShare" ::
                          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 DeletePortfolioShare where
  toJSON :: DeletePortfolioShare -> Value
toJSON DeletePortfolioShare' {Maybe Text
Maybe OrganizationNode
Text
portfolioId :: Text
organizationNode :: Maybe OrganizationNode
accountId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:DeletePortfolioShare' :: DeletePortfolioShare -> Text
$sel:organizationNode:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe OrganizationNode
$sel:accountId:DeletePortfolioShare' :: DeletePortfolioShare -> Maybe Text
$sel:acceptLanguage:DeletePortfolioShare' :: DeletePortfolioShare -> 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,
            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 DeletePortfolioShare where
  toPath :: DeletePortfolioShare -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DeletePortfolioShareResponse' 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', 'deletePortfolioShareResponse_portfolioShareToken' - The portfolio share unique identifier. This will only be returned if
-- delete is made to an organization node.
--
-- 'httpStatus', 'deletePortfolioShareResponse_httpStatus' - The response's http status code.
newDeletePortfolioShareResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeletePortfolioShareResponse
newDeletePortfolioShareResponse :: Int -> DeletePortfolioShareResponse
newDeletePortfolioShareResponse Int
pHttpStatus_ =
  DeletePortfolioShareResponse'
    { $sel:portfolioShareToken:DeletePortfolioShareResponse' :: Maybe Text
portfolioShareToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeletePortfolioShareResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The portfolio share unique identifier. This will only be returned if
-- delete is made to an organization node.
deletePortfolioShareResponse_portfolioShareToken :: Lens.Lens' DeletePortfolioShareResponse (Prelude.Maybe Prelude.Text)
deletePortfolioShareResponse_portfolioShareToken :: Lens' DeletePortfolioShareResponse (Maybe Text)
deletePortfolioShareResponse_portfolioShareToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePortfolioShareResponse' {Maybe Text
portfolioShareToken :: Maybe Text
$sel:portfolioShareToken:DeletePortfolioShareResponse' :: DeletePortfolioShareResponse -> Maybe Text
portfolioShareToken} -> Maybe Text
portfolioShareToken) (\s :: DeletePortfolioShareResponse
s@DeletePortfolioShareResponse' {} Maybe Text
a -> DeletePortfolioShareResponse
s {$sel:portfolioShareToken:DeletePortfolioShareResponse' :: Maybe Text
portfolioShareToken = Maybe Text
a} :: DeletePortfolioShareResponse)

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

instance Prelude.NFData DeletePortfolioShareResponse where
  rnf :: DeletePortfolioShareResponse -> ()
rnf DeletePortfolioShareResponse' {Int
Maybe Text
httpStatus :: Int
portfolioShareToken :: Maybe Text
$sel:httpStatus:DeletePortfolioShareResponse' :: DeletePortfolioShareResponse -> Int
$sel:portfolioShareToken:DeletePortfolioShareResponse' :: DeletePortfolioShareResponse -> 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