{-# 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.UpdatePortfolio
-- 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.
--
-- You cannot update a product that was shared with you.
module Amazonka.ServiceCatalog.UpdatePortfolio
  ( -- * Creating a Request
    UpdatePortfolio (..),
    newUpdatePortfolio,

    -- * Request Lenses
    updatePortfolio_acceptLanguage,
    updatePortfolio_addTags,
    updatePortfolio_description,
    updatePortfolio_displayName,
    updatePortfolio_providerName,
    updatePortfolio_removeTags,
    updatePortfolio_id,

    -- * Destructuring the Response
    UpdatePortfolioResponse (..),
    newUpdatePortfolioResponse,

    -- * Response Lenses
    updatePortfolioResponse_portfolioDetail,
    updatePortfolioResponse_tags,
    updatePortfolioResponse_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:/ 'newUpdatePortfolio' smart constructor.
data UpdatePortfolio = UpdatePortfolio'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    UpdatePortfolio -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The tags to add.
    UpdatePortfolio -> Maybe [Tag]
addTags :: Prelude.Maybe [Tag],
    -- | The updated description of the portfolio.
    UpdatePortfolio -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name to use for display purposes.
    UpdatePortfolio -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The updated name of the portfolio provider.
    UpdatePortfolio -> Maybe Text
providerName :: Prelude.Maybe Prelude.Text,
    -- | The tags to remove.
    UpdatePortfolio -> Maybe [Text]
removeTags :: Prelude.Maybe [Prelude.Text],
    -- | The portfolio identifier.
    UpdatePortfolio -> Text
id :: Prelude.Text
  }
  deriving (UpdatePortfolio -> UpdatePortfolio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePortfolio -> UpdatePortfolio -> Bool
$c/= :: UpdatePortfolio -> UpdatePortfolio -> Bool
== :: UpdatePortfolio -> UpdatePortfolio -> Bool
$c== :: UpdatePortfolio -> UpdatePortfolio -> Bool
Prelude.Eq, ReadPrec [UpdatePortfolio]
ReadPrec UpdatePortfolio
Int -> ReadS UpdatePortfolio
ReadS [UpdatePortfolio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePortfolio]
$creadListPrec :: ReadPrec [UpdatePortfolio]
readPrec :: ReadPrec UpdatePortfolio
$creadPrec :: ReadPrec UpdatePortfolio
readList :: ReadS [UpdatePortfolio]
$creadList :: ReadS [UpdatePortfolio]
readsPrec :: Int -> ReadS UpdatePortfolio
$creadsPrec :: Int -> ReadS UpdatePortfolio
Prelude.Read, Int -> UpdatePortfolio -> ShowS
[UpdatePortfolio] -> ShowS
UpdatePortfolio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePortfolio] -> ShowS
$cshowList :: [UpdatePortfolio] -> ShowS
show :: UpdatePortfolio -> String
$cshow :: UpdatePortfolio -> String
showsPrec :: Int -> UpdatePortfolio -> ShowS
$cshowsPrec :: Int -> UpdatePortfolio -> ShowS
Prelude.Show, forall x. Rep UpdatePortfolio x -> UpdatePortfolio
forall x. UpdatePortfolio -> Rep UpdatePortfolio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePortfolio x -> UpdatePortfolio
$cfrom :: forall x. UpdatePortfolio -> Rep UpdatePortfolio x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePortfolio' 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', 'updatePortfolio_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'addTags', 'updatePortfolio_addTags' - The tags to add.
--
-- 'description', 'updatePortfolio_description' - The updated description of the portfolio.
--
-- 'displayName', 'updatePortfolio_displayName' - The name to use for display purposes.
--
-- 'providerName', 'updatePortfolio_providerName' - The updated name of the portfolio provider.
--
-- 'removeTags', 'updatePortfolio_removeTags' - The tags to remove.
--
-- 'id', 'updatePortfolio_id' - The portfolio identifier.
newUpdatePortfolio ::
  -- | 'id'
  Prelude.Text ->
  UpdatePortfolio
newUpdatePortfolio :: Text -> UpdatePortfolio
newUpdatePortfolio Text
pId_ =
  UpdatePortfolio'
    { $sel:acceptLanguage:UpdatePortfolio' :: Maybe Text
acceptLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:addTags:UpdatePortfolio' :: Maybe [Tag]
addTags = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdatePortfolio' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:UpdatePortfolio' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:providerName:UpdatePortfolio' :: Maybe Text
providerName = forall a. Maybe a
Prelude.Nothing,
      $sel:removeTags:UpdatePortfolio' :: Maybe [Text]
removeTags = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdatePortfolio' :: Text
id = Text
pId_
    }

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

-- | The tags to add.
updatePortfolio_addTags :: Lens.Lens' UpdatePortfolio (Prelude.Maybe [Tag])
updatePortfolio_addTags :: Lens' UpdatePortfolio (Maybe [Tag])
updatePortfolio_addTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolio' {Maybe [Tag]
addTags :: Maybe [Tag]
$sel:addTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Tag]
addTags} -> Maybe [Tag]
addTags) (\s :: UpdatePortfolio
s@UpdatePortfolio' {} Maybe [Tag]
a -> UpdatePortfolio
s {$sel:addTags:UpdatePortfolio' :: Maybe [Tag]
addTags = Maybe [Tag]
a} :: UpdatePortfolio) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The updated description of the portfolio.
updatePortfolio_description :: Lens.Lens' UpdatePortfolio (Prelude.Maybe Prelude.Text)
updatePortfolio_description :: Lens' UpdatePortfolio (Maybe Text)
updatePortfolio_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolio' {Maybe Text
description :: Maybe Text
$sel:description:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdatePortfolio
s@UpdatePortfolio' {} Maybe Text
a -> UpdatePortfolio
s {$sel:description:UpdatePortfolio' :: Maybe Text
description = Maybe Text
a} :: UpdatePortfolio)

-- | The name to use for display purposes.
updatePortfolio_displayName :: Lens.Lens' UpdatePortfolio (Prelude.Maybe Prelude.Text)
updatePortfolio_displayName :: Lens' UpdatePortfolio (Maybe Text)
updatePortfolio_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolio' {Maybe Text
displayName :: Maybe Text
$sel:displayName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: UpdatePortfolio
s@UpdatePortfolio' {} Maybe Text
a -> UpdatePortfolio
s {$sel:displayName:UpdatePortfolio' :: Maybe Text
displayName = Maybe Text
a} :: UpdatePortfolio)

-- | The updated name of the portfolio provider.
updatePortfolio_providerName :: Lens.Lens' UpdatePortfolio (Prelude.Maybe Prelude.Text)
updatePortfolio_providerName :: Lens' UpdatePortfolio (Maybe Text)
updatePortfolio_providerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolio' {Maybe Text
providerName :: Maybe Text
$sel:providerName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
providerName} -> Maybe Text
providerName) (\s :: UpdatePortfolio
s@UpdatePortfolio' {} Maybe Text
a -> UpdatePortfolio
s {$sel:providerName:UpdatePortfolio' :: Maybe Text
providerName = Maybe Text
a} :: UpdatePortfolio)

-- | The tags to remove.
updatePortfolio_removeTags :: Lens.Lens' UpdatePortfolio (Prelude.Maybe [Prelude.Text])
updatePortfolio_removeTags :: Lens' UpdatePortfolio (Maybe [Text])
updatePortfolio_removeTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolio' {Maybe [Text]
removeTags :: Maybe [Text]
$sel:removeTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Text]
removeTags} -> Maybe [Text]
removeTags) (\s :: UpdatePortfolio
s@UpdatePortfolio' {} Maybe [Text]
a -> UpdatePortfolio
s {$sel:removeTags:UpdatePortfolio' :: Maybe [Text]
removeTags = Maybe [Text]
a} :: UpdatePortfolio) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Core.AWSRequest UpdatePortfolio where
  type
    AWSResponse UpdatePortfolio =
      UpdatePortfolioResponse
  request :: (Service -> Service) -> UpdatePortfolio -> Request UpdatePortfolio
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 UpdatePortfolio
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePortfolio)))
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 PortfolioDetail
-> Maybe [Tag] -> Int -> UpdatePortfolioResponse
UpdatePortfolioResponse'
            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
"PortfolioDetail")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 UpdatePortfolio where
  hashWithSalt :: Int -> UpdatePortfolio -> Int
hashWithSalt Int
_salt UpdatePortfolio' {Maybe [Text]
Maybe [Tag]
Maybe Text
Text
id :: Text
removeTags :: Maybe [Text]
providerName :: Maybe Text
displayName :: Maybe Text
description :: Maybe Text
addTags :: Maybe [Tag]
acceptLanguage :: Maybe Text
$sel:id:UpdatePortfolio' :: UpdatePortfolio -> Text
$sel:removeTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Text]
$sel:providerName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:displayName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:description:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:addTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Tag]
$sel:acceptLanguage:UpdatePortfolio' :: UpdatePortfolio -> 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 [Tag]
addTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
providerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
removeTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdatePortfolio where
  rnf :: UpdatePortfolio -> ()
rnf UpdatePortfolio' {Maybe [Text]
Maybe [Tag]
Maybe Text
Text
id :: Text
removeTags :: Maybe [Text]
providerName :: Maybe Text
displayName :: Maybe Text
description :: Maybe Text
addTags :: Maybe [Tag]
acceptLanguage :: Maybe Text
$sel:id:UpdatePortfolio' :: UpdatePortfolio -> Text
$sel:removeTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Text]
$sel:providerName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:displayName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:description:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:addTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Tag]
$sel:acceptLanguage:UpdatePortfolio' :: UpdatePortfolio -> 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 [Tag]
addTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
providerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
removeTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdatePortfolio where
  toHeaders :: UpdatePortfolio -> 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.UpdatePortfolio" ::
                          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 UpdatePortfolio where
  toJSON :: UpdatePortfolio -> Value
toJSON UpdatePortfolio' {Maybe [Text]
Maybe [Tag]
Maybe Text
Text
id :: Text
removeTags :: Maybe [Text]
providerName :: Maybe Text
displayName :: Maybe Text
description :: Maybe Text
addTags :: Maybe [Tag]
acceptLanguage :: Maybe Text
$sel:id:UpdatePortfolio' :: UpdatePortfolio -> Text
$sel:removeTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Text]
$sel:providerName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:displayName:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:description:UpdatePortfolio' :: UpdatePortfolio -> Maybe Text
$sel:addTags:UpdatePortfolio' :: UpdatePortfolio -> Maybe [Tag]
$sel:acceptLanguage:UpdatePortfolio' :: UpdatePortfolio -> 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
"AddTags" 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 [Tag]
addTags,
            (Key
"Description" 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
description,
            (Key
"DisplayName" 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
displayName,
            (Key
"ProviderName" 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
providerName,
            (Key
"RemoveTags" 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]
removeTags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdatePortfolioResponse' 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:
--
-- 'portfolioDetail', 'updatePortfolioResponse_portfolioDetail' - Information about the portfolio.
--
-- 'tags', 'updatePortfolioResponse_tags' - Information about the tags associated with the portfolio.
--
-- 'httpStatus', 'updatePortfolioResponse_httpStatus' - The response's http status code.
newUpdatePortfolioResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePortfolioResponse
newUpdatePortfolioResponse :: Int -> UpdatePortfolioResponse
newUpdatePortfolioResponse Int
pHttpStatus_ =
  UpdatePortfolioResponse'
    { $sel:portfolioDetail:UpdatePortfolioResponse' :: Maybe PortfolioDetail
portfolioDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UpdatePortfolioResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePortfolioResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the portfolio.
updatePortfolioResponse_portfolioDetail :: Lens.Lens' UpdatePortfolioResponse (Prelude.Maybe PortfolioDetail)
updatePortfolioResponse_portfolioDetail :: Lens' UpdatePortfolioResponse (Maybe PortfolioDetail)
updatePortfolioResponse_portfolioDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioResponse' {Maybe PortfolioDetail
portfolioDetail :: Maybe PortfolioDetail
$sel:portfolioDetail:UpdatePortfolioResponse' :: UpdatePortfolioResponse -> Maybe PortfolioDetail
portfolioDetail} -> Maybe PortfolioDetail
portfolioDetail) (\s :: UpdatePortfolioResponse
s@UpdatePortfolioResponse' {} Maybe PortfolioDetail
a -> UpdatePortfolioResponse
s {$sel:portfolioDetail:UpdatePortfolioResponse' :: Maybe PortfolioDetail
portfolioDetail = Maybe PortfolioDetail
a} :: UpdatePortfolioResponse)

-- | Information about the tags associated with the portfolio.
updatePortfolioResponse_tags :: Lens.Lens' UpdatePortfolioResponse (Prelude.Maybe [Tag])
updatePortfolioResponse_tags :: Lens' UpdatePortfolioResponse (Maybe [Tag])
updatePortfolioResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortfolioResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UpdatePortfolioResponse' :: UpdatePortfolioResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UpdatePortfolioResponse
s@UpdatePortfolioResponse' {} Maybe [Tag]
a -> UpdatePortfolioResponse
s {$sel:tags:UpdatePortfolioResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UpdatePortfolioResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData UpdatePortfolioResponse where
  rnf :: UpdatePortfolioResponse -> ()
rnf UpdatePortfolioResponse' {Int
Maybe [Tag]
Maybe PortfolioDetail
httpStatus :: Int
tags :: Maybe [Tag]
portfolioDetail :: Maybe PortfolioDetail
$sel:httpStatus:UpdatePortfolioResponse' :: UpdatePortfolioResponse -> Int
$sel:tags:UpdatePortfolioResponse' :: UpdatePortfolioResponse -> Maybe [Tag]
$sel:portfolioDetail:UpdatePortfolioResponse' :: UpdatePortfolioResponse -> Maybe PortfolioDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PortfolioDetail
portfolioDetail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus