{-# 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.LicenseManagerUserSubscriptions.StartProductSubscription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a product subscription for a user with the specified identity
-- provider.
--
-- Your estimated bill for charges on the number of users and related costs
-- will take 48 hours to appear for billing periods that haven\'t closed
-- (marked as __Pending__ billing status) in Amazon Web Services Billing.
-- For more information, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/invoice.html Viewing your monthly charges>
-- in the /Amazon Web Services Billing User Guide/.
module Amazonka.LicenseManagerUserSubscriptions.StartProductSubscription
  ( -- * Creating a Request
    StartProductSubscription (..),
    newStartProductSubscription,

    -- * Request Lenses
    startProductSubscription_domain,
    startProductSubscription_identityProvider,
    startProductSubscription_product,
    startProductSubscription_username,

    -- * Destructuring the Response
    StartProductSubscriptionResponse (..),
    newStartProductSubscriptionResponse,

    -- * Response Lenses
    startProductSubscriptionResponse_httpStatus,
    startProductSubscriptionResponse_productUserSummary,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LicenseManagerUserSubscriptions.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStartProductSubscription' smart constructor.
data StartProductSubscription = StartProductSubscription'
  { -- | The domain name of the user.
    StartProductSubscription -> Maybe Text
domain :: Prelude.Maybe Prelude.Text,
    -- | An object that specifies details for the identity provider.
    StartProductSubscription -> IdentityProvider
identityProvider :: IdentityProvider,
    -- | The name of the user-based subscription product.
    StartProductSubscription -> Text
product :: Prelude.Text,
    -- | The user name from the identity provider of the user.
    StartProductSubscription -> Text
username :: Prelude.Text
  }
  deriving (StartProductSubscription -> StartProductSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartProductSubscription -> StartProductSubscription -> Bool
$c/= :: StartProductSubscription -> StartProductSubscription -> Bool
== :: StartProductSubscription -> StartProductSubscription -> Bool
$c== :: StartProductSubscription -> StartProductSubscription -> Bool
Prelude.Eq, ReadPrec [StartProductSubscription]
ReadPrec StartProductSubscription
Int -> ReadS StartProductSubscription
ReadS [StartProductSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartProductSubscription]
$creadListPrec :: ReadPrec [StartProductSubscription]
readPrec :: ReadPrec StartProductSubscription
$creadPrec :: ReadPrec StartProductSubscription
readList :: ReadS [StartProductSubscription]
$creadList :: ReadS [StartProductSubscription]
readsPrec :: Int -> ReadS StartProductSubscription
$creadsPrec :: Int -> ReadS StartProductSubscription
Prelude.Read, Int -> StartProductSubscription -> ShowS
[StartProductSubscription] -> ShowS
StartProductSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartProductSubscription] -> ShowS
$cshowList :: [StartProductSubscription] -> ShowS
show :: StartProductSubscription -> String
$cshow :: StartProductSubscription -> String
showsPrec :: Int -> StartProductSubscription -> ShowS
$cshowsPrec :: Int -> StartProductSubscription -> ShowS
Prelude.Show, forall x.
Rep StartProductSubscription x -> StartProductSubscription
forall x.
StartProductSubscription -> Rep StartProductSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartProductSubscription x -> StartProductSubscription
$cfrom :: forall x.
StartProductSubscription -> Rep StartProductSubscription x
Prelude.Generic)

-- |
-- Create a value of 'StartProductSubscription' 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:
--
-- 'domain', 'startProductSubscription_domain' - The domain name of the user.
--
-- 'identityProvider', 'startProductSubscription_identityProvider' - An object that specifies details for the identity provider.
--
-- 'product', 'startProductSubscription_product' - The name of the user-based subscription product.
--
-- 'username', 'startProductSubscription_username' - The user name from the identity provider of the user.
newStartProductSubscription ::
  -- | 'identityProvider'
  IdentityProvider ->
  -- | 'product'
  Prelude.Text ->
  -- | 'username'
  Prelude.Text ->
  StartProductSubscription
newStartProductSubscription :: IdentityProvider -> Text -> Text -> StartProductSubscription
newStartProductSubscription
  IdentityProvider
pIdentityProvider_
  Text
pProduct_
  Text
pUsername_ =
    StartProductSubscription'
      { $sel:domain:StartProductSubscription' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
        $sel:identityProvider:StartProductSubscription' :: IdentityProvider
identityProvider = IdentityProvider
pIdentityProvider_,
        $sel:product:StartProductSubscription' :: Text
product = Text
pProduct_,
        $sel:username:StartProductSubscription' :: Text
username = Text
pUsername_
      }

-- | The domain name of the user.
startProductSubscription_domain :: Lens.Lens' StartProductSubscription (Prelude.Maybe Prelude.Text)
startProductSubscription_domain :: Lens' StartProductSubscription (Maybe Text)
startProductSubscription_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProductSubscription' {Maybe Text
domain :: Maybe Text
$sel:domain:StartProductSubscription' :: StartProductSubscription -> Maybe Text
domain} -> Maybe Text
domain) (\s :: StartProductSubscription
s@StartProductSubscription' {} Maybe Text
a -> StartProductSubscription
s {$sel:domain:StartProductSubscription' :: Maybe Text
domain = Maybe Text
a} :: StartProductSubscription)

-- | An object that specifies details for the identity provider.
startProductSubscription_identityProvider :: Lens.Lens' StartProductSubscription IdentityProvider
startProductSubscription_identityProvider :: Lens' StartProductSubscription IdentityProvider
startProductSubscription_identityProvider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProductSubscription' {IdentityProvider
identityProvider :: IdentityProvider
$sel:identityProvider:StartProductSubscription' :: StartProductSubscription -> IdentityProvider
identityProvider} -> IdentityProvider
identityProvider) (\s :: StartProductSubscription
s@StartProductSubscription' {} IdentityProvider
a -> StartProductSubscription
s {$sel:identityProvider:StartProductSubscription' :: IdentityProvider
identityProvider = IdentityProvider
a} :: StartProductSubscription)

-- | The name of the user-based subscription product.
startProductSubscription_product :: Lens.Lens' StartProductSubscription Prelude.Text
startProductSubscription_product :: Lens' StartProductSubscription Text
startProductSubscription_product = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProductSubscription' {Text
product :: Text
$sel:product:StartProductSubscription' :: StartProductSubscription -> Text
product} -> Text
product) (\s :: StartProductSubscription
s@StartProductSubscription' {} Text
a -> StartProductSubscription
s {$sel:product:StartProductSubscription' :: Text
product = Text
a} :: StartProductSubscription)

-- | The user name from the identity provider of the user.
startProductSubscription_username :: Lens.Lens' StartProductSubscription Prelude.Text
startProductSubscription_username :: Lens' StartProductSubscription Text
startProductSubscription_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProductSubscription' {Text
username :: Text
$sel:username:StartProductSubscription' :: StartProductSubscription -> Text
username} -> Text
username) (\s :: StartProductSubscription
s@StartProductSubscription' {} Text
a -> StartProductSubscription
s {$sel:username:StartProductSubscription' :: Text
username = Text
a} :: StartProductSubscription)

instance Core.AWSRequest StartProductSubscription where
  type
    AWSResponse StartProductSubscription =
      StartProductSubscriptionResponse
  request :: (Service -> Service)
-> StartProductSubscription -> Request StartProductSubscription
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 StartProductSubscription
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartProductSubscription)))
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 ->
          Int -> ProductUserSummary -> StartProductSubscriptionResponse
StartProductSubscriptionResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ProductUserSummary")
      )

instance Prelude.Hashable StartProductSubscription where
  hashWithSalt :: Int -> StartProductSubscription -> Int
hashWithSalt Int
_salt StartProductSubscription' {Maybe Text
Text
IdentityProvider
username :: Text
product :: Text
identityProvider :: IdentityProvider
domain :: Maybe Text
$sel:username:StartProductSubscription' :: StartProductSubscription -> Text
$sel:product:StartProductSubscription' :: StartProductSubscription -> Text
$sel:identityProvider:StartProductSubscription' :: StartProductSubscription -> IdentityProvider
$sel:domain:StartProductSubscription' :: StartProductSubscription -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IdentityProvider
identityProvider
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
product
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
username

instance Prelude.NFData StartProductSubscription where
  rnf :: StartProductSubscription -> ()
rnf StartProductSubscription' {Maybe Text
Text
IdentityProvider
username :: Text
product :: Text
identityProvider :: IdentityProvider
domain :: Maybe Text
$sel:username:StartProductSubscription' :: StartProductSubscription -> Text
$sel:product:StartProductSubscription' :: StartProductSubscription -> Text
$sel:identityProvider:StartProductSubscription' :: StartProductSubscription -> IdentityProvider
$sel:domain:StartProductSubscription' :: StartProductSubscription -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IdentityProvider
identityProvider
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
product
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
username

instance Data.ToHeaders StartProductSubscription where
  toHeaders :: StartProductSubscription -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartProductSubscription where
  toJSON :: StartProductSubscription -> Value
toJSON StartProductSubscription' {Maybe Text
Text
IdentityProvider
username :: Text
product :: Text
identityProvider :: IdentityProvider
domain :: Maybe Text
$sel:username:StartProductSubscription' :: StartProductSubscription -> Text
$sel:product:StartProductSubscription' :: StartProductSubscription -> Text
$sel:identityProvider:StartProductSubscription' :: StartProductSubscription -> IdentityProvider
$sel:domain:StartProductSubscription' :: StartProductSubscription -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Domain" 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
domain,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityProvider" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IdentityProvider
identityProvider),
            forall a. a -> Maybe a
Prelude.Just (Key
"Product" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
product),
            forall a. a -> Maybe a
Prelude.Just (Key
"Username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
username)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartProductSubscriptionResponse' 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', 'startProductSubscriptionResponse_httpStatus' - The response's http status code.
--
-- 'productUserSummary', 'startProductSubscriptionResponse_productUserSummary' - Metadata that describes the start product subscription operation.
newStartProductSubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'productUserSummary'
  ProductUserSummary ->
  StartProductSubscriptionResponse
newStartProductSubscriptionResponse :: Int -> ProductUserSummary -> StartProductSubscriptionResponse
newStartProductSubscriptionResponse
  Int
pHttpStatus_
  ProductUserSummary
pProductUserSummary_ =
    StartProductSubscriptionResponse'
      { $sel:httpStatus:StartProductSubscriptionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:productUserSummary:StartProductSubscriptionResponse' :: ProductUserSummary
productUserSummary = ProductUserSummary
pProductUserSummary_
      }

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

-- | Metadata that describes the start product subscription operation.
startProductSubscriptionResponse_productUserSummary :: Lens.Lens' StartProductSubscriptionResponse ProductUserSummary
startProductSubscriptionResponse_productUserSummary :: Lens' StartProductSubscriptionResponse ProductUserSummary
startProductSubscriptionResponse_productUserSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProductSubscriptionResponse' {ProductUserSummary
productUserSummary :: ProductUserSummary
$sel:productUserSummary:StartProductSubscriptionResponse' :: StartProductSubscriptionResponse -> ProductUserSummary
productUserSummary} -> ProductUserSummary
productUserSummary) (\s :: StartProductSubscriptionResponse
s@StartProductSubscriptionResponse' {} ProductUserSummary
a -> StartProductSubscriptionResponse
s {$sel:productUserSummary:StartProductSubscriptionResponse' :: ProductUserSummary
productUserSummary = ProductUserSummary
a} :: StartProductSubscriptionResponse)

instance
  Prelude.NFData
    StartProductSubscriptionResponse
  where
  rnf :: StartProductSubscriptionResponse -> ()
rnf StartProductSubscriptionResponse' {Int
ProductUserSummary
productUserSummary :: ProductUserSummary
httpStatus :: Int
$sel:productUserSummary:StartProductSubscriptionResponse' :: StartProductSubscriptionResponse -> ProductUserSummary
$sel:httpStatus:StartProductSubscriptionResponse' :: StartProductSubscriptionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProductUserSummary
productUserSummary