{-# 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.AssociateProductWithPortfolio
-- 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 product with the specified portfolio.
--
-- A delegated admin is authorized to invoke this command.
module Amazonka.ServiceCatalog.AssociateProductWithPortfolio
  ( -- * Creating a Request
    AssociateProductWithPortfolio (..),
    newAssociateProductWithPortfolio,

    -- * Request Lenses
    associateProductWithPortfolio_acceptLanguage,
    associateProductWithPortfolio_sourcePortfolioId,
    associateProductWithPortfolio_productId,
    associateProductWithPortfolio_portfolioId,

    -- * Destructuring the Response
    AssociateProductWithPortfolioResponse (..),
    newAssociateProductWithPortfolioResponse,

    -- * Response Lenses
    associateProductWithPortfolioResponse_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:/ 'newAssociateProductWithPortfolio' smart constructor.
data AssociateProductWithPortfolio = AssociateProductWithPortfolio'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    AssociateProductWithPortfolio -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the source portfolio.
    AssociateProductWithPortfolio -> Maybe Text
sourcePortfolioId :: Prelude.Maybe Prelude.Text,
    -- | The product identifier.
    AssociateProductWithPortfolio -> Text
productId :: Prelude.Text,
    -- | The portfolio identifier.
    AssociateProductWithPortfolio -> Text
portfolioId :: Prelude.Text
  }
  deriving (AssociateProductWithPortfolio
-> AssociateProductWithPortfolio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateProductWithPortfolio
-> AssociateProductWithPortfolio -> Bool
$c/= :: AssociateProductWithPortfolio
-> AssociateProductWithPortfolio -> Bool
== :: AssociateProductWithPortfolio
-> AssociateProductWithPortfolio -> Bool
$c== :: AssociateProductWithPortfolio
-> AssociateProductWithPortfolio -> Bool
Prelude.Eq, ReadPrec [AssociateProductWithPortfolio]
ReadPrec AssociateProductWithPortfolio
Int -> ReadS AssociateProductWithPortfolio
ReadS [AssociateProductWithPortfolio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateProductWithPortfolio]
$creadListPrec :: ReadPrec [AssociateProductWithPortfolio]
readPrec :: ReadPrec AssociateProductWithPortfolio
$creadPrec :: ReadPrec AssociateProductWithPortfolio
readList :: ReadS [AssociateProductWithPortfolio]
$creadList :: ReadS [AssociateProductWithPortfolio]
readsPrec :: Int -> ReadS AssociateProductWithPortfolio
$creadsPrec :: Int -> ReadS AssociateProductWithPortfolio
Prelude.Read, Int -> AssociateProductWithPortfolio -> ShowS
[AssociateProductWithPortfolio] -> ShowS
AssociateProductWithPortfolio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateProductWithPortfolio] -> ShowS
$cshowList :: [AssociateProductWithPortfolio] -> ShowS
show :: AssociateProductWithPortfolio -> String
$cshow :: AssociateProductWithPortfolio -> String
showsPrec :: Int -> AssociateProductWithPortfolio -> ShowS
$cshowsPrec :: Int -> AssociateProductWithPortfolio -> ShowS
Prelude.Show, forall x.
Rep AssociateProductWithPortfolio x
-> AssociateProductWithPortfolio
forall x.
AssociateProductWithPortfolio
-> Rep AssociateProductWithPortfolio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateProductWithPortfolio x
-> AssociateProductWithPortfolio
$cfrom :: forall x.
AssociateProductWithPortfolio
-> Rep AssociateProductWithPortfolio x
Prelude.Generic)

-- |
-- Create a value of 'AssociateProductWithPortfolio' 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', 'associateProductWithPortfolio_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'sourcePortfolioId', 'associateProductWithPortfolio_sourcePortfolioId' - The identifier of the source portfolio.
--
-- 'productId', 'associateProductWithPortfolio_productId' - The product identifier.
--
-- 'portfolioId', 'associateProductWithPortfolio_portfolioId' - The portfolio identifier.
newAssociateProductWithPortfolio ::
  -- | 'productId'
  Prelude.Text ->
  -- | 'portfolioId'
  Prelude.Text ->
  AssociateProductWithPortfolio
newAssociateProductWithPortfolio :: Text -> Text -> AssociateProductWithPortfolio
newAssociateProductWithPortfolio
  Text
pProductId_
  Text
pPortfolioId_ =
    AssociateProductWithPortfolio'
      { $sel:acceptLanguage:AssociateProductWithPortfolio' :: Maybe Text
acceptLanguage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourcePortfolioId:AssociateProductWithPortfolio' :: Maybe Text
sourcePortfolioId = forall a. Maybe a
Prelude.Nothing,
        $sel:productId:AssociateProductWithPortfolio' :: Text
productId = Text
pProductId_,
        $sel:portfolioId:AssociateProductWithPortfolio' :: Text
portfolioId = Text
pPortfolioId_
      }

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

-- | The identifier of the source portfolio.
associateProductWithPortfolio_sourcePortfolioId :: Lens.Lens' AssociateProductWithPortfolio (Prelude.Maybe Prelude.Text)
associateProductWithPortfolio_sourcePortfolioId :: Lens' AssociateProductWithPortfolio (Maybe Text)
associateProductWithPortfolio_sourcePortfolioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateProductWithPortfolio' {Maybe Text
sourcePortfolioId :: Maybe Text
$sel:sourcePortfolioId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Maybe Text
sourcePortfolioId} -> Maybe Text
sourcePortfolioId) (\s :: AssociateProductWithPortfolio
s@AssociateProductWithPortfolio' {} Maybe Text
a -> AssociateProductWithPortfolio
s {$sel:sourcePortfolioId:AssociateProductWithPortfolio' :: Maybe Text
sourcePortfolioId = Maybe Text
a} :: AssociateProductWithPortfolio)

-- | The product identifier.
associateProductWithPortfolio_productId :: Lens.Lens' AssociateProductWithPortfolio Prelude.Text
associateProductWithPortfolio_productId :: Lens' AssociateProductWithPortfolio Text
associateProductWithPortfolio_productId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateProductWithPortfolio' {Text
productId :: Text
$sel:productId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Text
productId} -> Text
productId) (\s :: AssociateProductWithPortfolio
s@AssociateProductWithPortfolio' {} Text
a -> AssociateProductWithPortfolio
s {$sel:productId:AssociateProductWithPortfolio' :: Text
productId = Text
a} :: AssociateProductWithPortfolio)

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

instance
  Core.AWSRequest
    AssociateProductWithPortfolio
  where
  type
    AWSResponse AssociateProductWithPortfolio =
      AssociateProductWithPortfolioResponse
  request :: (Service -> Service)
-> AssociateProductWithPortfolio
-> Request AssociateProductWithPortfolio
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 AssociateProductWithPortfolio
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateProductWithPortfolio)))
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 -> AssociateProductWithPortfolioResponse
AssociateProductWithPortfolioResponse'
            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
    AssociateProductWithPortfolio
  where
  hashWithSalt :: Int -> AssociateProductWithPortfolio -> Int
hashWithSalt Int
_salt AssociateProductWithPortfolio' {Maybe Text
Text
portfolioId :: Text
productId :: Text
sourcePortfolioId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Text
$sel:productId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Text
$sel:sourcePortfolioId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Maybe Text
$sel:acceptLanguage:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> 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
sourcePortfolioId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portfolioId

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

instance Data.ToHeaders AssociateProductWithPortfolio where
  toHeaders :: AssociateProductWithPortfolio -> 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.AssociateProductWithPortfolio" ::
                          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 AssociateProductWithPortfolio where
  toJSON :: AssociateProductWithPortfolio -> Value
toJSON AssociateProductWithPortfolio' {Maybe Text
Text
portfolioId :: Text
productId :: Text
sourcePortfolioId :: Maybe Text
acceptLanguage :: Maybe Text
$sel:portfolioId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Text
$sel:productId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Text
$sel:sourcePortfolioId:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> Maybe Text
$sel:acceptLanguage:AssociateProductWithPortfolio' :: AssociateProductWithPortfolio -> 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
"SourcePortfolioId" 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
sourcePortfolioId,
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productId),
            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 AssociateProductWithPortfolio where
  toPath :: AssociateProductWithPortfolio -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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