{-# 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.DescribePortfolioShareStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the status of the specified portfolio share operation. This API can
-- only be called by the management account in the organization or by a
-- delegated admin.
module Amazonka.ServiceCatalog.DescribePortfolioShareStatus
  ( -- * Creating a Request
    DescribePortfolioShareStatus (..),
    newDescribePortfolioShareStatus,

    -- * Request Lenses
    describePortfolioShareStatus_portfolioShareToken,

    -- * Destructuring the Response
    DescribePortfolioShareStatusResponse (..),
    newDescribePortfolioShareStatusResponse,

    -- * Response Lenses
    describePortfolioShareStatusResponse_organizationNodeValue,
    describePortfolioShareStatusResponse_portfolioId,
    describePortfolioShareStatusResponse_portfolioShareToken,
    describePortfolioShareStatusResponse_shareDetails,
    describePortfolioShareStatusResponse_status,
    describePortfolioShareStatusResponse_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:/ 'newDescribePortfolioShareStatus' smart constructor.
data DescribePortfolioShareStatus = DescribePortfolioShareStatus'
  { -- | The token for the portfolio share operation. This token is returned
    -- either by CreatePortfolioShare or by DeletePortfolioShare.
    DescribePortfolioShareStatus -> Text
portfolioShareToken :: Prelude.Text
  }
  deriving (DescribePortfolioShareStatus
-> DescribePortfolioShareStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePortfolioShareStatus
-> DescribePortfolioShareStatus -> Bool
$c/= :: DescribePortfolioShareStatus
-> DescribePortfolioShareStatus -> Bool
== :: DescribePortfolioShareStatus
-> DescribePortfolioShareStatus -> Bool
$c== :: DescribePortfolioShareStatus
-> DescribePortfolioShareStatus -> Bool
Prelude.Eq, ReadPrec [DescribePortfolioShareStatus]
ReadPrec DescribePortfolioShareStatus
Int -> ReadS DescribePortfolioShareStatus
ReadS [DescribePortfolioShareStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePortfolioShareStatus]
$creadListPrec :: ReadPrec [DescribePortfolioShareStatus]
readPrec :: ReadPrec DescribePortfolioShareStatus
$creadPrec :: ReadPrec DescribePortfolioShareStatus
readList :: ReadS [DescribePortfolioShareStatus]
$creadList :: ReadS [DescribePortfolioShareStatus]
readsPrec :: Int -> ReadS DescribePortfolioShareStatus
$creadsPrec :: Int -> ReadS DescribePortfolioShareStatus
Prelude.Read, Int -> DescribePortfolioShareStatus -> ShowS
[DescribePortfolioShareStatus] -> ShowS
DescribePortfolioShareStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePortfolioShareStatus] -> ShowS
$cshowList :: [DescribePortfolioShareStatus] -> ShowS
show :: DescribePortfolioShareStatus -> String
$cshow :: DescribePortfolioShareStatus -> String
showsPrec :: Int -> DescribePortfolioShareStatus -> ShowS
$cshowsPrec :: Int -> DescribePortfolioShareStatus -> ShowS
Prelude.Show, forall x.
Rep DescribePortfolioShareStatus x -> DescribePortfolioShareStatus
forall x.
DescribePortfolioShareStatus -> Rep DescribePortfolioShareStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePortfolioShareStatus x -> DescribePortfolioShareStatus
$cfrom :: forall x.
DescribePortfolioShareStatus -> Rep DescribePortfolioShareStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribePortfolioShareStatus' 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', 'describePortfolioShareStatus_portfolioShareToken' - The token for the portfolio share operation. This token is returned
-- either by CreatePortfolioShare or by DeletePortfolioShare.
newDescribePortfolioShareStatus ::
  -- | 'portfolioShareToken'
  Prelude.Text ->
  DescribePortfolioShareStatus
newDescribePortfolioShareStatus :: Text -> DescribePortfolioShareStatus
newDescribePortfolioShareStatus Text
pPortfolioShareToken_ =
  DescribePortfolioShareStatus'
    { $sel:portfolioShareToken:DescribePortfolioShareStatus' :: Text
portfolioShareToken =
        Text
pPortfolioShareToken_
    }

-- | The token for the portfolio share operation. This token is returned
-- either by CreatePortfolioShare or by DeletePortfolioShare.
describePortfolioShareStatus_portfolioShareToken :: Lens.Lens' DescribePortfolioShareStatus Prelude.Text
describePortfolioShareStatus_portfolioShareToken :: Lens' DescribePortfolioShareStatus Text
describePortfolioShareStatus_portfolioShareToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortfolioShareStatus' {Text
portfolioShareToken :: Text
$sel:portfolioShareToken:DescribePortfolioShareStatus' :: DescribePortfolioShareStatus -> Text
portfolioShareToken} -> Text
portfolioShareToken) (\s :: DescribePortfolioShareStatus
s@DescribePortfolioShareStatus' {} Text
a -> DescribePortfolioShareStatus
s {$sel:portfolioShareToken:DescribePortfolioShareStatus' :: Text
portfolioShareToken = Text
a} :: DescribePortfolioShareStatus)

instance Core.AWSRequest DescribePortfolioShareStatus where
  type
    AWSResponse DescribePortfolioShareStatus =
      DescribePortfolioShareStatusResponse
  request :: (Service -> Service)
-> DescribePortfolioShareStatus
-> Request DescribePortfolioShareStatus
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 DescribePortfolioShareStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribePortfolioShareStatus)))
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 Text
-> Maybe Text
-> Maybe ShareDetails
-> Maybe ShareStatus
-> Int
-> DescribePortfolioShareStatusResponse
DescribePortfolioShareStatusResponse'
            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
"OrganizationNodeValue")
            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
"PortfolioId")
            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
"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
"ShareDetails")
            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
    DescribePortfolioShareStatus
  where
  hashWithSalt :: Int -> DescribePortfolioShareStatus -> Int
hashWithSalt Int
_salt DescribePortfolioShareStatus' {Text
portfolioShareToken :: Text
$sel:portfolioShareToken:DescribePortfolioShareStatus' :: DescribePortfolioShareStatus -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portfolioShareToken

instance Prelude.NFData DescribePortfolioShareStatus where
  rnf :: DescribePortfolioShareStatus -> ()
rnf DescribePortfolioShareStatus' {Text
portfolioShareToken :: Text
$sel:portfolioShareToken:DescribePortfolioShareStatus' :: DescribePortfolioShareStatus -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
portfolioShareToken

instance Data.ToHeaders DescribePortfolioShareStatus where
  toHeaders :: DescribePortfolioShareStatus -> 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.DescribePortfolioShareStatus" ::
                          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 DescribePortfolioShareStatus where
  toJSON :: DescribePortfolioShareStatus -> Value
toJSON DescribePortfolioShareStatus' {Text
portfolioShareToken :: Text
$sel:portfolioShareToken:DescribePortfolioShareStatus' :: DescribePortfolioShareStatus -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"PortfolioShareToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
portfolioShareToken)
          ]
      )

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

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

-- | /See:/ 'newDescribePortfolioShareStatusResponse' smart constructor.
data DescribePortfolioShareStatusResponse = DescribePortfolioShareStatusResponse'
  { -- | Organization node identifier. It can be either account id,
    -- organizational unit id or organization id.
    DescribePortfolioShareStatusResponse -> Maybe Text
organizationNodeValue :: Prelude.Maybe Prelude.Text,
    -- | The portfolio identifier.
    DescribePortfolioShareStatusResponse -> Maybe Text
portfolioId :: Prelude.Maybe Prelude.Text,
    -- | The token for the portfolio share operation. For example,
    -- @share-6v24abcdefghi@.
    DescribePortfolioShareStatusResponse -> Maybe Text
portfolioShareToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the portfolio share operation.
    DescribePortfolioShareStatusResponse -> Maybe ShareDetails
shareDetails :: Prelude.Maybe ShareDetails,
    -- | Status of the portfolio share operation.
    DescribePortfolioShareStatusResponse -> Maybe ShareStatus
status :: Prelude.Maybe ShareStatus,
    -- | The response's http status code.
    DescribePortfolioShareStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePortfolioShareStatusResponse
-> DescribePortfolioShareStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePortfolioShareStatusResponse
-> DescribePortfolioShareStatusResponse -> Bool
$c/= :: DescribePortfolioShareStatusResponse
-> DescribePortfolioShareStatusResponse -> Bool
== :: DescribePortfolioShareStatusResponse
-> DescribePortfolioShareStatusResponse -> Bool
$c== :: DescribePortfolioShareStatusResponse
-> DescribePortfolioShareStatusResponse -> Bool
Prelude.Eq, ReadPrec [DescribePortfolioShareStatusResponse]
ReadPrec DescribePortfolioShareStatusResponse
Int -> ReadS DescribePortfolioShareStatusResponse
ReadS [DescribePortfolioShareStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePortfolioShareStatusResponse]
$creadListPrec :: ReadPrec [DescribePortfolioShareStatusResponse]
readPrec :: ReadPrec DescribePortfolioShareStatusResponse
$creadPrec :: ReadPrec DescribePortfolioShareStatusResponse
readList :: ReadS [DescribePortfolioShareStatusResponse]
$creadList :: ReadS [DescribePortfolioShareStatusResponse]
readsPrec :: Int -> ReadS DescribePortfolioShareStatusResponse
$creadsPrec :: Int -> ReadS DescribePortfolioShareStatusResponse
Prelude.Read, Int -> DescribePortfolioShareStatusResponse -> ShowS
[DescribePortfolioShareStatusResponse] -> ShowS
DescribePortfolioShareStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePortfolioShareStatusResponse] -> ShowS
$cshowList :: [DescribePortfolioShareStatusResponse] -> ShowS
show :: DescribePortfolioShareStatusResponse -> String
$cshow :: DescribePortfolioShareStatusResponse -> String
showsPrec :: Int -> DescribePortfolioShareStatusResponse -> ShowS
$cshowsPrec :: Int -> DescribePortfolioShareStatusResponse -> ShowS
Prelude.Show, forall x.
Rep DescribePortfolioShareStatusResponse x
-> DescribePortfolioShareStatusResponse
forall x.
DescribePortfolioShareStatusResponse
-> Rep DescribePortfolioShareStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePortfolioShareStatusResponse x
-> DescribePortfolioShareStatusResponse
$cfrom :: forall x.
DescribePortfolioShareStatusResponse
-> Rep DescribePortfolioShareStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePortfolioShareStatusResponse' 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:
--
-- 'organizationNodeValue', 'describePortfolioShareStatusResponse_organizationNodeValue' - Organization node identifier. It can be either account id,
-- organizational unit id or organization id.
--
-- 'portfolioId', 'describePortfolioShareStatusResponse_portfolioId' - The portfolio identifier.
--
-- 'portfolioShareToken', 'describePortfolioShareStatusResponse_portfolioShareToken' - The token for the portfolio share operation. For example,
-- @share-6v24abcdefghi@.
--
-- 'shareDetails', 'describePortfolioShareStatusResponse_shareDetails' - Information about the portfolio share operation.
--
-- 'status', 'describePortfolioShareStatusResponse_status' - Status of the portfolio share operation.
--
-- 'httpStatus', 'describePortfolioShareStatusResponse_httpStatus' - The response's http status code.
newDescribePortfolioShareStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePortfolioShareStatusResponse
newDescribePortfolioShareStatusResponse :: Int -> DescribePortfolioShareStatusResponse
newDescribePortfolioShareStatusResponse Int
pHttpStatus_ =
  DescribePortfolioShareStatusResponse'
    { $sel:organizationNodeValue:DescribePortfolioShareStatusResponse' :: Maybe Text
organizationNodeValue =
        forall a. Maybe a
Prelude.Nothing,
      $sel:portfolioId:DescribePortfolioShareStatusResponse' :: Maybe Text
portfolioId = forall a. Maybe a
Prelude.Nothing,
      $sel:portfolioShareToken:DescribePortfolioShareStatusResponse' :: Maybe Text
portfolioShareToken = forall a. Maybe a
Prelude.Nothing,
      $sel:shareDetails:DescribePortfolioShareStatusResponse' :: Maybe ShareDetails
shareDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribePortfolioShareStatusResponse' :: Maybe ShareStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePortfolioShareStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Organization node identifier. It can be either account id,
-- organizational unit id or organization id.
describePortfolioShareStatusResponse_organizationNodeValue :: Lens.Lens' DescribePortfolioShareStatusResponse (Prelude.Maybe Prelude.Text)
describePortfolioShareStatusResponse_organizationNodeValue :: Lens' DescribePortfolioShareStatusResponse (Maybe Text)
describePortfolioShareStatusResponse_organizationNodeValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortfolioShareStatusResponse' {Maybe Text
organizationNodeValue :: Maybe Text
$sel:organizationNodeValue:DescribePortfolioShareStatusResponse' :: DescribePortfolioShareStatusResponse -> Maybe Text
organizationNodeValue} -> Maybe Text
organizationNodeValue) (\s :: DescribePortfolioShareStatusResponse
s@DescribePortfolioShareStatusResponse' {} Maybe Text
a -> DescribePortfolioShareStatusResponse
s {$sel:organizationNodeValue:DescribePortfolioShareStatusResponse' :: Maybe Text
organizationNodeValue = Maybe Text
a} :: DescribePortfolioShareStatusResponse)

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

-- | The token for the portfolio share operation. For example,
-- @share-6v24abcdefghi@.
describePortfolioShareStatusResponse_portfolioShareToken :: Lens.Lens' DescribePortfolioShareStatusResponse (Prelude.Maybe Prelude.Text)
describePortfolioShareStatusResponse_portfolioShareToken :: Lens' DescribePortfolioShareStatusResponse (Maybe Text)
describePortfolioShareStatusResponse_portfolioShareToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortfolioShareStatusResponse' {Maybe Text
portfolioShareToken :: Maybe Text
$sel:portfolioShareToken:DescribePortfolioShareStatusResponse' :: DescribePortfolioShareStatusResponse -> Maybe Text
portfolioShareToken} -> Maybe Text
portfolioShareToken) (\s :: DescribePortfolioShareStatusResponse
s@DescribePortfolioShareStatusResponse' {} Maybe Text
a -> DescribePortfolioShareStatusResponse
s {$sel:portfolioShareToken:DescribePortfolioShareStatusResponse' :: Maybe Text
portfolioShareToken = Maybe Text
a} :: DescribePortfolioShareStatusResponse)

-- | Information about the portfolio share operation.
describePortfolioShareStatusResponse_shareDetails :: Lens.Lens' DescribePortfolioShareStatusResponse (Prelude.Maybe ShareDetails)
describePortfolioShareStatusResponse_shareDetails :: Lens' DescribePortfolioShareStatusResponse (Maybe ShareDetails)
describePortfolioShareStatusResponse_shareDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortfolioShareStatusResponse' {Maybe ShareDetails
shareDetails :: Maybe ShareDetails
$sel:shareDetails:DescribePortfolioShareStatusResponse' :: DescribePortfolioShareStatusResponse -> Maybe ShareDetails
shareDetails} -> Maybe ShareDetails
shareDetails) (\s :: DescribePortfolioShareStatusResponse
s@DescribePortfolioShareStatusResponse' {} Maybe ShareDetails
a -> DescribePortfolioShareStatusResponse
s {$sel:shareDetails:DescribePortfolioShareStatusResponse' :: Maybe ShareDetails
shareDetails = Maybe ShareDetails
a} :: DescribePortfolioShareStatusResponse)

-- | Status of the portfolio share operation.
describePortfolioShareStatusResponse_status :: Lens.Lens' DescribePortfolioShareStatusResponse (Prelude.Maybe ShareStatus)
describePortfolioShareStatusResponse_status :: Lens' DescribePortfolioShareStatusResponse (Maybe ShareStatus)
describePortfolioShareStatusResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortfolioShareStatusResponse' {Maybe ShareStatus
status :: Maybe ShareStatus
$sel:status:DescribePortfolioShareStatusResponse' :: DescribePortfolioShareStatusResponse -> Maybe ShareStatus
status} -> Maybe ShareStatus
status) (\s :: DescribePortfolioShareStatusResponse
s@DescribePortfolioShareStatusResponse' {} Maybe ShareStatus
a -> DescribePortfolioShareStatusResponse
s {$sel:status:DescribePortfolioShareStatusResponse' :: Maybe ShareStatus
status = Maybe ShareStatus
a} :: DescribePortfolioShareStatusResponse)

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

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