{-# 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.AssociatePrincipalWithPortfolio
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates the specified principal ARN with the specified portfolio.
--
-- If you share the portfolio with principal name sharing enabled, the
-- @PrincipalARN@ association is included in the share.
--
-- The @PortfolioID@, @PrincipalARN@, and @PrincipalType@ parameters are
-- required.
--
-- You can associate a maximum of 10 Principals with a portfolio using
-- @PrincipalType@ as @IAM_PATTERN@
--
-- 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.AssociatePrincipalWithPortfolio
  ( -- * Creating a Request
    AssociatePrincipalWithPortfolio (..),
    newAssociatePrincipalWithPortfolio,

    -- * Request Lenses
    associatePrincipalWithPortfolio_acceptLanguage,
    associatePrincipalWithPortfolio_portfolioId,
    associatePrincipalWithPortfolio_principalARN,
    associatePrincipalWithPortfolio_principalType,

    -- * Destructuring the Response
    AssociatePrincipalWithPortfolioResponse (..),
    newAssociatePrincipalWithPortfolioResponse,

    -- * Response Lenses
    associatePrincipalWithPortfolioResponse_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:/ 'newAssociatePrincipalWithPortfolio' smart constructor.
data AssociatePrincipalWithPortfolio = AssociatePrincipalWithPortfolio'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    AssociatePrincipalWithPortfolio -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The portfolio identifier.
    AssociatePrincipalWithPortfolio -> Text
portfolioId :: Prelude.Text,
    -- | The ARN of the principal (IAM user, role, or group). This field allows
    -- an ARN with no @accountID@ if @PrincipalType@ is @IAM_PATTERN@.
    --
    -- You can associate multiple @IAM@ patterns even if the account has no
    -- principal with that name. This is useful in Principal Name Sharing if
    -- you want to share a principal without creating it in the account that
    -- owns the portfolio.
    AssociatePrincipalWithPortfolio -> Text
principalARN :: Prelude.Text,
    -- | The principal type. The supported value is @IAM@ if you use a fully
    -- defined ARN, or @IAM_PATTERN@ if you use an ARN with no @accountID@.
    AssociatePrincipalWithPortfolio -> PrincipalType
principalType :: PrincipalType
  }
  deriving (AssociatePrincipalWithPortfolio
-> AssociatePrincipalWithPortfolio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociatePrincipalWithPortfolio
-> AssociatePrincipalWithPortfolio -> Bool
$c/= :: AssociatePrincipalWithPortfolio
-> AssociatePrincipalWithPortfolio -> Bool
== :: AssociatePrincipalWithPortfolio
-> AssociatePrincipalWithPortfolio -> Bool
$c== :: AssociatePrincipalWithPortfolio
-> AssociatePrincipalWithPortfolio -> Bool
Prelude.Eq, ReadPrec [AssociatePrincipalWithPortfolio]
ReadPrec AssociatePrincipalWithPortfolio
Int -> ReadS AssociatePrincipalWithPortfolio
ReadS [AssociatePrincipalWithPortfolio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociatePrincipalWithPortfolio]
$creadListPrec :: ReadPrec [AssociatePrincipalWithPortfolio]
readPrec :: ReadPrec AssociatePrincipalWithPortfolio
$creadPrec :: ReadPrec AssociatePrincipalWithPortfolio
readList :: ReadS [AssociatePrincipalWithPortfolio]
$creadList :: ReadS [AssociatePrincipalWithPortfolio]
readsPrec :: Int -> ReadS AssociatePrincipalWithPortfolio
$creadsPrec :: Int -> ReadS AssociatePrincipalWithPortfolio
Prelude.Read, Int -> AssociatePrincipalWithPortfolio -> ShowS
[AssociatePrincipalWithPortfolio] -> ShowS
AssociatePrincipalWithPortfolio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociatePrincipalWithPortfolio] -> ShowS
$cshowList :: [AssociatePrincipalWithPortfolio] -> ShowS
show :: AssociatePrincipalWithPortfolio -> String
$cshow :: AssociatePrincipalWithPortfolio -> String
showsPrec :: Int -> AssociatePrincipalWithPortfolio -> ShowS
$cshowsPrec :: Int -> AssociatePrincipalWithPortfolio -> ShowS
Prelude.Show, forall x.
Rep AssociatePrincipalWithPortfolio x
-> AssociatePrincipalWithPortfolio
forall x.
AssociatePrincipalWithPortfolio
-> Rep AssociatePrincipalWithPortfolio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociatePrincipalWithPortfolio x
-> AssociatePrincipalWithPortfolio
$cfrom :: forall x.
AssociatePrincipalWithPortfolio
-> Rep AssociatePrincipalWithPortfolio x
Prelude.Generic)

-- |
-- Create a value of 'AssociatePrincipalWithPortfolio' 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', 'associatePrincipalWithPortfolio_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'portfolioId', 'associatePrincipalWithPortfolio_portfolioId' - The portfolio identifier.
--
-- 'principalARN', 'associatePrincipalWithPortfolio_principalARN' - The ARN of the principal (IAM user, role, or group). This field allows
-- an ARN with no @accountID@ if @PrincipalType@ is @IAM_PATTERN@.
--
-- You can associate multiple @IAM@ patterns even if the account has no
-- principal with that name. This is useful in Principal Name Sharing if
-- you want to share a principal without creating it in the account that
-- owns the portfolio.
--
-- 'principalType', 'associatePrincipalWithPortfolio_principalType' - The principal type. The supported value is @IAM@ if you use a fully
-- defined ARN, or @IAM_PATTERN@ if you use an ARN with no @accountID@.
newAssociatePrincipalWithPortfolio ::
  -- | 'portfolioId'
  Prelude.Text ->
  -- | 'principalARN'
  Prelude.Text ->
  -- | 'principalType'
  PrincipalType ->
  AssociatePrincipalWithPortfolio
newAssociatePrincipalWithPortfolio :: Text -> Text -> PrincipalType -> AssociatePrincipalWithPortfolio
newAssociatePrincipalWithPortfolio
  Text
pPortfolioId_
  Text
pPrincipalARN_
  PrincipalType
pPrincipalType_ =
    AssociatePrincipalWithPortfolio'
      { $sel:acceptLanguage:AssociatePrincipalWithPortfolio' :: Maybe Text
acceptLanguage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:portfolioId:AssociatePrincipalWithPortfolio' :: Text
portfolioId = Text
pPortfolioId_,
        $sel:principalARN:AssociatePrincipalWithPortfolio' :: Text
principalARN = Text
pPrincipalARN_,
        $sel:principalType:AssociatePrincipalWithPortfolio' :: PrincipalType
principalType = PrincipalType
pPrincipalType_
      }

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

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

-- | The ARN of the principal (IAM user, role, or group). This field allows
-- an ARN with no @accountID@ if @PrincipalType@ is @IAM_PATTERN@.
--
-- You can associate multiple @IAM@ patterns even if the account has no
-- principal with that name. This is useful in Principal Name Sharing if
-- you want to share a principal without creating it in the account that
-- owns the portfolio.
associatePrincipalWithPortfolio_principalARN :: Lens.Lens' AssociatePrincipalWithPortfolio Prelude.Text
associatePrincipalWithPortfolio_principalARN :: Lens' AssociatePrincipalWithPortfolio Text
associatePrincipalWithPortfolio_principalARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociatePrincipalWithPortfolio' {Text
principalARN :: Text
$sel:principalARN:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
principalARN} -> Text
principalARN) (\s :: AssociatePrincipalWithPortfolio
s@AssociatePrincipalWithPortfolio' {} Text
a -> AssociatePrincipalWithPortfolio
s {$sel:principalARN:AssociatePrincipalWithPortfolio' :: Text
principalARN = Text
a} :: AssociatePrincipalWithPortfolio)

-- | The principal type. The supported value is @IAM@ if you use a fully
-- defined ARN, or @IAM_PATTERN@ if you use an ARN with no @accountID@.
associatePrincipalWithPortfolio_principalType :: Lens.Lens' AssociatePrincipalWithPortfolio PrincipalType
associatePrincipalWithPortfolio_principalType :: Lens' AssociatePrincipalWithPortfolio PrincipalType
associatePrincipalWithPortfolio_principalType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociatePrincipalWithPortfolio' {PrincipalType
principalType :: PrincipalType
$sel:principalType:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> PrincipalType
principalType} -> PrincipalType
principalType) (\s :: AssociatePrincipalWithPortfolio
s@AssociatePrincipalWithPortfolio' {} PrincipalType
a -> AssociatePrincipalWithPortfolio
s {$sel:principalType:AssociatePrincipalWithPortfolio' :: PrincipalType
principalType = PrincipalType
a} :: AssociatePrincipalWithPortfolio)

instance
  Core.AWSRequest
    AssociatePrincipalWithPortfolio
  where
  type
    AWSResponse AssociatePrincipalWithPortfolio =
      AssociatePrincipalWithPortfolioResponse
  request :: (Service -> Service)
-> AssociatePrincipalWithPortfolio
-> Request AssociatePrincipalWithPortfolio
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 AssociatePrincipalWithPortfolio
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociatePrincipalWithPortfolio)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociatePrincipalWithPortfolioResponse
AssociatePrincipalWithPortfolioResponse'
            forall (f :: * -> *) a b. Functor 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
    AssociatePrincipalWithPortfolio
  where
  hashWithSalt :: Int -> AssociatePrincipalWithPortfolio -> Int
hashWithSalt
    Int
_salt
    AssociatePrincipalWithPortfolio' {Maybe Text
Text
PrincipalType
principalType :: PrincipalType
principalARN :: Text
portfolioId :: Text
acceptLanguage :: Maybe Text
$sel:principalType:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> PrincipalType
$sel:principalARN:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:portfolioId:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:acceptLanguage:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> 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` Text
portfolioId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principalARN
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PrincipalType
principalType

instance
  Prelude.NFData
    AssociatePrincipalWithPortfolio
  where
  rnf :: AssociatePrincipalWithPortfolio -> ()
rnf AssociatePrincipalWithPortfolio' {Maybe Text
Text
PrincipalType
principalType :: PrincipalType
principalARN :: Text
portfolioId :: Text
acceptLanguage :: Maybe Text
$sel:principalType:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> PrincipalType
$sel:principalARN:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:portfolioId:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:acceptLanguage:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> 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 Text
portfolioId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
principalARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PrincipalType
principalType

instance
  Data.ToHeaders
    AssociatePrincipalWithPortfolio
  where
  toHeaders :: AssociatePrincipalWithPortfolio -> 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.AssociatePrincipalWithPortfolio" ::
                          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 AssociatePrincipalWithPortfolio where
  toJSON :: AssociatePrincipalWithPortfolio -> Value
toJSON AssociatePrincipalWithPortfolio' {Maybe Text
Text
PrincipalType
principalType :: PrincipalType
principalARN :: Text
portfolioId :: Text
acceptLanguage :: Maybe Text
$sel:principalType:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> PrincipalType
$sel:principalARN:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:portfolioId:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> Text
$sel:acceptLanguage:AssociatePrincipalWithPortfolio' :: AssociatePrincipalWithPortfolio -> 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,
            forall a. a -> Maybe a
Prelude.Just (Key
"PortfolioId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
portfolioId),
            forall a. a -> Maybe a
Prelude.Just (Key
"PrincipalARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
principalARN),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PrincipalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PrincipalType
principalType)
          ]
      )

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

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

-- | /See:/ 'newAssociatePrincipalWithPortfolioResponse' smart constructor.
data AssociatePrincipalWithPortfolioResponse = AssociatePrincipalWithPortfolioResponse'
  { -- | The response's http status code.
    AssociatePrincipalWithPortfolioResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociatePrincipalWithPortfolioResponse
-> AssociatePrincipalWithPortfolioResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociatePrincipalWithPortfolioResponse
-> AssociatePrincipalWithPortfolioResponse -> Bool
$c/= :: AssociatePrincipalWithPortfolioResponse
-> AssociatePrincipalWithPortfolioResponse -> Bool
== :: AssociatePrincipalWithPortfolioResponse
-> AssociatePrincipalWithPortfolioResponse -> Bool
$c== :: AssociatePrincipalWithPortfolioResponse
-> AssociatePrincipalWithPortfolioResponse -> Bool
Prelude.Eq, ReadPrec [AssociatePrincipalWithPortfolioResponse]
ReadPrec AssociatePrincipalWithPortfolioResponse
Int -> ReadS AssociatePrincipalWithPortfolioResponse
ReadS [AssociatePrincipalWithPortfolioResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociatePrincipalWithPortfolioResponse]
$creadListPrec :: ReadPrec [AssociatePrincipalWithPortfolioResponse]
readPrec :: ReadPrec AssociatePrincipalWithPortfolioResponse
$creadPrec :: ReadPrec AssociatePrincipalWithPortfolioResponse
readList :: ReadS [AssociatePrincipalWithPortfolioResponse]
$creadList :: ReadS [AssociatePrincipalWithPortfolioResponse]
readsPrec :: Int -> ReadS AssociatePrincipalWithPortfolioResponse
$creadsPrec :: Int -> ReadS AssociatePrincipalWithPortfolioResponse
Prelude.Read, Int -> AssociatePrincipalWithPortfolioResponse -> ShowS
[AssociatePrincipalWithPortfolioResponse] -> ShowS
AssociatePrincipalWithPortfolioResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociatePrincipalWithPortfolioResponse] -> ShowS
$cshowList :: [AssociatePrincipalWithPortfolioResponse] -> ShowS
show :: AssociatePrincipalWithPortfolioResponse -> String
$cshow :: AssociatePrincipalWithPortfolioResponse -> String
showsPrec :: Int -> AssociatePrincipalWithPortfolioResponse -> ShowS
$cshowsPrec :: Int -> AssociatePrincipalWithPortfolioResponse -> ShowS
Prelude.Show, forall x.
Rep AssociatePrincipalWithPortfolioResponse x
-> AssociatePrincipalWithPortfolioResponse
forall x.
AssociatePrincipalWithPortfolioResponse
-> Rep AssociatePrincipalWithPortfolioResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociatePrincipalWithPortfolioResponse x
-> AssociatePrincipalWithPortfolioResponse
$cfrom :: forall x.
AssociatePrincipalWithPortfolioResponse
-> Rep AssociatePrincipalWithPortfolioResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociatePrincipalWithPortfolioResponse' 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:
--
-- 'httpStatus', 'associatePrincipalWithPortfolioResponse_httpStatus' - The response's http status code.
newAssociatePrincipalWithPortfolioResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociatePrincipalWithPortfolioResponse
newAssociatePrincipalWithPortfolioResponse :: Int -> AssociatePrincipalWithPortfolioResponse
newAssociatePrincipalWithPortfolioResponse
  Int
pHttpStatus_ =
    AssociatePrincipalWithPortfolioResponse'
      { $sel:httpStatus:AssociatePrincipalWithPortfolioResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    AssociatePrincipalWithPortfolioResponse
  where
  rnf :: AssociatePrincipalWithPortfolioResponse -> ()
rnf AssociatePrincipalWithPortfolioResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociatePrincipalWithPortfolioResponse' :: AssociatePrincipalWithPortfolioResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus