{-# 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.LicenseManager.CreateLicenseVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new version of the specified license.
module Amazonka.LicenseManager.CreateLicenseVersion
  ( -- * Creating a Request
    CreateLicenseVersion (..),
    newCreateLicenseVersion,

    -- * Request Lenses
    createLicenseVersion_licenseMetadata,
    createLicenseVersion_sourceVersion,
    createLicenseVersion_licenseArn,
    createLicenseVersion_licenseName,
    createLicenseVersion_productName,
    createLicenseVersion_issuer,
    createLicenseVersion_homeRegion,
    createLicenseVersion_validity,
    createLicenseVersion_entitlements,
    createLicenseVersion_consumptionConfiguration,
    createLicenseVersion_status,
    createLicenseVersion_clientToken,

    -- * Destructuring the Response
    CreateLicenseVersionResponse (..),
    newCreateLicenseVersionResponse,

    -- * Response Lenses
    createLicenseVersionResponse_licenseArn,
    createLicenseVersionResponse_status,
    createLicenseVersionResponse_version,
    createLicenseVersionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLicenseVersion' smart constructor.
data CreateLicenseVersion = CreateLicenseVersion'
  { -- | Information about the license.
    CreateLicenseVersion -> Maybe [Metadata]
licenseMetadata :: Prelude.Maybe [Metadata],
    -- | Current version of the license.
    CreateLicenseVersion -> Maybe Text
sourceVersion :: Prelude.Maybe Prelude.Text,
    -- | Amazon Resource Name (ARN) of the license.
    CreateLicenseVersion -> Text
licenseArn :: Prelude.Text,
    -- | License name.
    CreateLicenseVersion -> Text
licenseName :: Prelude.Text,
    -- | Product name.
    CreateLicenseVersion -> Text
productName :: Prelude.Text,
    -- | License issuer.
    CreateLicenseVersion -> Issuer
issuer :: Issuer,
    -- | Home Region of the license.
    CreateLicenseVersion -> Text
homeRegion :: Prelude.Text,
    -- | Date and time range during which the license is valid, in ISO8601-UTC
    -- format.
    CreateLicenseVersion -> DatetimeRange
validity :: DatetimeRange,
    -- | License entitlements.
    CreateLicenseVersion -> [Entitlement]
entitlements :: [Entitlement],
    -- | Configuration for consumption of the license. Choose a provisional
    -- configuration for workloads running with continuous connectivity. Choose
    -- a borrow configuration for workloads with offline usage.
    CreateLicenseVersion -> ConsumptionConfiguration
consumptionConfiguration :: ConsumptionConfiguration,
    -- | License status.
    CreateLicenseVersion -> LicenseStatus
status :: LicenseStatus,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateLicenseVersion -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateLicenseVersion -> CreateLicenseVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLicenseVersion -> CreateLicenseVersion -> Bool
$c/= :: CreateLicenseVersion -> CreateLicenseVersion -> Bool
== :: CreateLicenseVersion -> CreateLicenseVersion -> Bool
$c== :: CreateLicenseVersion -> CreateLicenseVersion -> Bool
Prelude.Eq, ReadPrec [CreateLicenseVersion]
ReadPrec CreateLicenseVersion
Int -> ReadS CreateLicenseVersion
ReadS [CreateLicenseVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLicenseVersion]
$creadListPrec :: ReadPrec [CreateLicenseVersion]
readPrec :: ReadPrec CreateLicenseVersion
$creadPrec :: ReadPrec CreateLicenseVersion
readList :: ReadS [CreateLicenseVersion]
$creadList :: ReadS [CreateLicenseVersion]
readsPrec :: Int -> ReadS CreateLicenseVersion
$creadsPrec :: Int -> ReadS CreateLicenseVersion
Prelude.Read, Int -> CreateLicenseVersion -> ShowS
[CreateLicenseVersion] -> ShowS
CreateLicenseVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLicenseVersion] -> ShowS
$cshowList :: [CreateLicenseVersion] -> ShowS
show :: CreateLicenseVersion -> String
$cshow :: CreateLicenseVersion -> String
showsPrec :: Int -> CreateLicenseVersion -> ShowS
$cshowsPrec :: Int -> CreateLicenseVersion -> ShowS
Prelude.Show, forall x. Rep CreateLicenseVersion x -> CreateLicenseVersion
forall x. CreateLicenseVersion -> Rep CreateLicenseVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLicenseVersion x -> CreateLicenseVersion
$cfrom :: forall x. CreateLicenseVersion -> Rep CreateLicenseVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateLicenseVersion' 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:
--
-- 'licenseMetadata', 'createLicenseVersion_licenseMetadata' - Information about the license.
--
-- 'sourceVersion', 'createLicenseVersion_sourceVersion' - Current version of the license.
--
-- 'licenseArn', 'createLicenseVersion_licenseArn' - Amazon Resource Name (ARN) of the license.
--
-- 'licenseName', 'createLicenseVersion_licenseName' - License name.
--
-- 'productName', 'createLicenseVersion_productName' - Product name.
--
-- 'issuer', 'createLicenseVersion_issuer' - License issuer.
--
-- 'homeRegion', 'createLicenseVersion_homeRegion' - Home Region of the license.
--
-- 'validity', 'createLicenseVersion_validity' - Date and time range during which the license is valid, in ISO8601-UTC
-- format.
--
-- 'entitlements', 'createLicenseVersion_entitlements' - License entitlements.
--
-- 'consumptionConfiguration', 'createLicenseVersion_consumptionConfiguration' - Configuration for consumption of the license. Choose a provisional
-- configuration for workloads running with continuous connectivity. Choose
-- a borrow configuration for workloads with offline usage.
--
-- 'status', 'createLicenseVersion_status' - License status.
--
-- 'clientToken', 'createLicenseVersion_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
newCreateLicenseVersion ::
  -- | 'licenseArn'
  Prelude.Text ->
  -- | 'licenseName'
  Prelude.Text ->
  -- | 'productName'
  Prelude.Text ->
  -- | 'issuer'
  Issuer ->
  -- | 'homeRegion'
  Prelude.Text ->
  -- | 'validity'
  DatetimeRange ->
  -- | 'consumptionConfiguration'
  ConsumptionConfiguration ->
  -- | 'status'
  LicenseStatus ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateLicenseVersion
newCreateLicenseVersion :: Text
-> Text
-> Text
-> Issuer
-> Text
-> DatetimeRange
-> ConsumptionConfiguration
-> LicenseStatus
-> Text
-> CreateLicenseVersion
newCreateLicenseVersion
  Text
pLicenseArn_
  Text
pLicenseName_
  Text
pProductName_
  Issuer
pIssuer_
  Text
pHomeRegion_
  DatetimeRange
pValidity_
  ConsumptionConfiguration
pConsumptionConfiguration_
  LicenseStatus
pStatus_
  Text
pClientToken_ =
    CreateLicenseVersion'
      { $sel:licenseMetadata:CreateLicenseVersion' :: Maybe [Metadata]
licenseMetadata =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourceVersion:CreateLicenseVersion' :: Maybe Text
sourceVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:licenseArn:CreateLicenseVersion' :: Text
licenseArn = Text
pLicenseArn_,
        $sel:licenseName:CreateLicenseVersion' :: Text
licenseName = Text
pLicenseName_,
        $sel:productName:CreateLicenseVersion' :: Text
productName = Text
pProductName_,
        $sel:issuer:CreateLicenseVersion' :: Issuer
issuer = Issuer
pIssuer_,
        $sel:homeRegion:CreateLicenseVersion' :: Text
homeRegion = Text
pHomeRegion_,
        $sel:validity:CreateLicenseVersion' :: DatetimeRange
validity = DatetimeRange
pValidity_,
        $sel:entitlements:CreateLicenseVersion' :: [Entitlement]
entitlements = forall a. Monoid a => a
Prelude.mempty,
        $sel:consumptionConfiguration:CreateLicenseVersion' :: ConsumptionConfiguration
consumptionConfiguration =
          ConsumptionConfiguration
pConsumptionConfiguration_,
        $sel:status:CreateLicenseVersion' :: LicenseStatus
status = LicenseStatus
pStatus_,
        $sel:clientToken:CreateLicenseVersion' :: Text
clientToken = Text
pClientToken_
      }

-- | Information about the license.
createLicenseVersion_licenseMetadata :: Lens.Lens' CreateLicenseVersion (Prelude.Maybe [Metadata])
createLicenseVersion_licenseMetadata :: Lens' CreateLicenseVersion (Maybe [Metadata])
createLicenseVersion_licenseMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Maybe [Metadata]
licenseMetadata :: Maybe [Metadata]
$sel:licenseMetadata:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe [Metadata]
licenseMetadata} -> Maybe [Metadata]
licenseMetadata) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Maybe [Metadata]
a -> CreateLicenseVersion
s {$sel:licenseMetadata:CreateLicenseVersion' :: Maybe [Metadata]
licenseMetadata = Maybe [Metadata]
a} :: CreateLicenseVersion) 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

-- | Current version of the license.
createLicenseVersion_sourceVersion :: Lens.Lens' CreateLicenseVersion (Prelude.Maybe Prelude.Text)
createLicenseVersion_sourceVersion :: Lens' CreateLicenseVersion (Maybe Text)
createLicenseVersion_sourceVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Maybe Text
sourceVersion :: Maybe Text
$sel:sourceVersion:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe Text
sourceVersion} -> Maybe Text
sourceVersion) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Maybe Text
a -> CreateLicenseVersion
s {$sel:sourceVersion:CreateLicenseVersion' :: Maybe Text
sourceVersion = Maybe Text
a} :: CreateLicenseVersion)

-- | Amazon Resource Name (ARN) of the license.
createLicenseVersion_licenseArn :: Lens.Lens' CreateLicenseVersion Prelude.Text
createLicenseVersion_licenseArn :: Lens' CreateLicenseVersion Text
createLicenseVersion_licenseArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Text
licenseArn :: Text
$sel:licenseArn:CreateLicenseVersion' :: CreateLicenseVersion -> Text
licenseArn} -> Text
licenseArn) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Text
a -> CreateLicenseVersion
s {$sel:licenseArn:CreateLicenseVersion' :: Text
licenseArn = Text
a} :: CreateLicenseVersion)

-- | License name.
createLicenseVersion_licenseName :: Lens.Lens' CreateLicenseVersion Prelude.Text
createLicenseVersion_licenseName :: Lens' CreateLicenseVersion Text
createLicenseVersion_licenseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Text
licenseName :: Text
$sel:licenseName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
licenseName} -> Text
licenseName) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Text
a -> CreateLicenseVersion
s {$sel:licenseName:CreateLicenseVersion' :: Text
licenseName = Text
a} :: CreateLicenseVersion)

-- | Product name.
createLicenseVersion_productName :: Lens.Lens' CreateLicenseVersion Prelude.Text
createLicenseVersion_productName :: Lens' CreateLicenseVersion Text
createLicenseVersion_productName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Text
productName :: Text
$sel:productName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
productName} -> Text
productName) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Text
a -> CreateLicenseVersion
s {$sel:productName:CreateLicenseVersion' :: Text
productName = Text
a} :: CreateLicenseVersion)

-- | License issuer.
createLicenseVersion_issuer :: Lens.Lens' CreateLicenseVersion Issuer
createLicenseVersion_issuer :: Lens' CreateLicenseVersion Issuer
createLicenseVersion_issuer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Issuer
issuer :: Issuer
$sel:issuer:CreateLicenseVersion' :: CreateLicenseVersion -> Issuer
issuer} -> Issuer
issuer) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Issuer
a -> CreateLicenseVersion
s {$sel:issuer:CreateLicenseVersion' :: Issuer
issuer = Issuer
a} :: CreateLicenseVersion)

-- | Home Region of the license.
createLicenseVersion_homeRegion :: Lens.Lens' CreateLicenseVersion Prelude.Text
createLicenseVersion_homeRegion :: Lens' CreateLicenseVersion Text
createLicenseVersion_homeRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Text
homeRegion :: Text
$sel:homeRegion:CreateLicenseVersion' :: CreateLicenseVersion -> Text
homeRegion} -> Text
homeRegion) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Text
a -> CreateLicenseVersion
s {$sel:homeRegion:CreateLicenseVersion' :: Text
homeRegion = Text
a} :: CreateLicenseVersion)

-- | Date and time range during which the license is valid, in ISO8601-UTC
-- format.
createLicenseVersion_validity :: Lens.Lens' CreateLicenseVersion DatetimeRange
createLicenseVersion_validity :: Lens' CreateLicenseVersion DatetimeRange
createLicenseVersion_validity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {DatetimeRange
validity :: DatetimeRange
$sel:validity:CreateLicenseVersion' :: CreateLicenseVersion -> DatetimeRange
validity} -> DatetimeRange
validity) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} DatetimeRange
a -> CreateLicenseVersion
s {$sel:validity:CreateLicenseVersion' :: DatetimeRange
validity = DatetimeRange
a} :: CreateLicenseVersion)

-- | License entitlements.
createLicenseVersion_entitlements :: Lens.Lens' CreateLicenseVersion [Entitlement]
createLicenseVersion_entitlements :: Lens' CreateLicenseVersion [Entitlement]
createLicenseVersion_entitlements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {[Entitlement]
entitlements :: [Entitlement]
$sel:entitlements:CreateLicenseVersion' :: CreateLicenseVersion -> [Entitlement]
entitlements} -> [Entitlement]
entitlements) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} [Entitlement]
a -> CreateLicenseVersion
s {$sel:entitlements:CreateLicenseVersion' :: [Entitlement]
entitlements = [Entitlement]
a} :: CreateLicenseVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Configuration for consumption of the license. Choose a provisional
-- configuration for workloads running with continuous connectivity. Choose
-- a borrow configuration for workloads with offline usage.
createLicenseVersion_consumptionConfiguration :: Lens.Lens' CreateLicenseVersion ConsumptionConfiguration
createLicenseVersion_consumptionConfiguration :: Lens' CreateLicenseVersion ConsumptionConfiguration
createLicenseVersion_consumptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {ConsumptionConfiguration
consumptionConfiguration :: ConsumptionConfiguration
$sel:consumptionConfiguration:CreateLicenseVersion' :: CreateLicenseVersion -> ConsumptionConfiguration
consumptionConfiguration} -> ConsumptionConfiguration
consumptionConfiguration) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} ConsumptionConfiguration
a -> CreateLicenseVersion
s {$sel:consumptionConfiguration:CreateLicenseVersion' :: ConsumptionConfiguration
consumptionConfiguration = ConsumptionConfiguration
a} :: CreateLicenseVersion)

-- | License status.
createLicenseVersion_status :: Lens.Lens' CreateLicenseVersion LicenseStatus
createLicenseVersion_status :: Lens' CreateLicenseVersion LicenseStatus
createLicenseVersion_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {LicenseStatus
status :: LicenseStatus
$sel:status:CreateLicenseVersion' :: CreateLicenseVersion -> LicenseStatus
status} -> LicenseStatus
status) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} LicenseStatus
a -> CreateLicenseVersion
s {$sel:status:CreateLicenseVersion' :: LicenseStatus
status = LicenseStatus
a} :: CreateLicenseVersion)

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createLicenseVersion_clientToken :: Lens.Lens' CreateLicenseVersion Prelude.Text
createLicenseVersion_clientToken :: Lens' CreateLicenseVersion Text
createLicenseVersion_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersion' {Text
clientToken :: Text
$sel:clientToken:CreateLicenseVersion' :: CreateLicenseVersion -> Text
clientToken} -> Text
clientToken) (\s :: CreateLicenseVersion
s@CreateLicenseVersion' {} Text
a -> CreateLicenseVersion
s {$sel:clientToken:CreateLicenseVersion' :: Text
clientToken = Text
a} :: CreateLicenseVersion)

instance Core.AWSRequest CreateLicenseVersion where
  type
    AWSResponse CreateLicenseVersion =
      CreateLicenseVersionResponse
  request :: (Service -> Service)
-> CreateLicenseVersion -> Request CreateLicenseVersion
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 CreateLicenseVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLicenseVersion)))
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 LicenseStatus
-> Maybe Text
-> Int
-> CreateLicenseVersionResponse
CreateLicenseVersionResponse'
            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
"LicenseArn")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Version")
            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 CreateLicenseVersion where
  hashWithSalt :: Int -> CreateLicenseVersion -> Int
hashWithSalt Int
_salt CreateLicenseVersion' {[Entitlement]
Maybe [Metadata]
Maybe Text
Text
DatetimeRange
Issuer
LicenseStatus
ConsumptionConfiguration
clientToken :: Text
status :: LicenseStatus
consumptionConfiguration :: ConsumptionConfiguration
entitlements :: [Entitlement]
validity :: DatetimeRange
homeRegion :: Text
issuer :: Issuer
productName :: Text
licenseName :: Text
licenseArn :: Text
sourceVersion :: Maybe Text
licenseMetadata :: Maybe [Metadata]
$sel:clientToken:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:status:CreateLicenseVersion' :: CreateLicenseVersion -> LicenseStatus
$sel:consumptionConfiguration:CreateLicenseVersion' :: CreateLicenseVersion -> ConsumptionConfiguration
$sel:entitlements:CreateLicenseVersion' :: CreateLicenseVersion -> [Entitlement]
$sel:validity:CreateLicenseVersion' :: CreateLicenseVersion -> DatetimeRange
$sel:homeRegion:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:issuer:CreateLicenseVersion' :: CreateLicenseVersion -> Issuer
$sel:productName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseArn:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:sourceVersion:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe Text
$sel:licenseMetadata:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe [Metadata]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Metadata]
licenseMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
licenseArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
licenseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Issuer
issuer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
homeRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DatetimeRange
validity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Entitlement]
entitlements
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConsumptionConfiguration
consumptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LicenseStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateLicenseVersion where
  rnf :: CreateLicenseVersion -> ()
rnf CreateLicenseVersion' {[Entitlement]
Maybe [Metadata]
Maybe Text
Text
DatetimeRange
Issuer
LicenseStatus
ConsumptionConfiguration
clientToken :: Text
status :: LicenseStatus
consumptionConfiguration :: ConsumptionConfiguration
entitlements :: [Entitlement]
validity :: DatetimeRange
homeRegion :: Text
issuer :: Issuer
productName :: Text
licenseName :: Text
licenseArn :: Text
sourceVersion :: Maybe Text
licenseMetadata :: Maybe [Metadata]
$sel:clientToken:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:status:CreateLicenseVersion' :: CreateLicenseVersion -> LicenseStatus
$sel:consumptionConfiguration:CreateLicenseVersion' :: CreateLicenseVersion -> ConsumptionConfiguration
$sel:entitlements:CreateLicenseVersion' :: CreateLicenseVersion -> [Entitlement]
$sel:validity:CreateLicenseVersion' :: CreateLicenseVersion -> DatetimeRange
$sel:homeRegion:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:issuer:CreateLicenseVersion' :: CreateLicenseVersion -> Issuer
$sel:productName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseArn:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:sourceVersion:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe Text
$sel:licenseMetadata:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe [Metadata]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Metadata]
licenseMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
licenseArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
licenseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
productName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Issuer
issuer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
homeRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DatetimeRange
validity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Entitlement]
entitlements
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConsumptionConfiguration
consumptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LicenseStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateLicenseVersion where
  toHeaders :: CreateLicenseVersion -> 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
"AWSLicenseManager.CreateLicenseVersion" ::
                          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 CreateLicenseVersion where
  toJSON :: CreateLicenseVersion -> Value
toJSON CreateLicenseVersion' {[Entitlement]
Maybe [Metadata]
Maybe Text
Text
DatetimeRange
Issuer
LicenseStatus
ConsumptionConfiguration
clientToken :: Text
status :: LicenseStatus
consumptionConfiguration :: ConsumptionConfiguration
entitlements :: [Entitlement]
validity :: DatetimeRange
homeRegion :: Text
issuer :: Issuer
productName :: Text
licenseName :: Text
licenseArn :: Text
sourceVersion :: Maybe Text
licenseMetadata :: Maybe [Metadata]
$sel:clientToken:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:status:CreateLicenseVersion' :: CreateLicenseVersion -> LicenseStatus
$sel:consumptionConfiguration:CreateLicenseVersion' :: CreateLicenseVersion -> ConsumptionConfiguration
$sel:entitlements:CreateLicenseVersion' :: CreateLicenseVersion -> [Entitlement]
$sel:validity:CreateLicenseVersion' :: CreateLicenseVersion -> DatetimeRange
$sel:homeRegion:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:issuer:CreateLicenseVersion' :: CreateLicenseVersion -> Issuer
$sel:productName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseName:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:licenseArn:CreateLicenseVersion' :: CreateLicenseVersion -> Text
$sel:sourceVersion:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe Text
$sel:licenseMetadata:CreateLicenseVersion' :: CreateLicenseVersion -> Maybe [Metadata]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LicenseMetadata" 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 [Metadata]
licenseMetadata,
            (Key
"SourceVersion" 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
sourceVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"LicenseArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
licenseArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"LicenseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
licenseName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Issuer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Issuer
issuer),
            forall a. a -> Maybe a
Prelude.Just (Key
"HomeRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
homeRegion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Validity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DatetimeRange
validity),
            forall a. a -> Maybe a
Prelude.Just (Key
"Entitlements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Entitlement]
entitlements),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConsumptionConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConsumptionConfiguration
consumptionConfiguration
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LicenseStatus
status),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLicenseVersionResponse' 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:
--
-- 'licenseArn', 'createLicenseVersionResponse_licenseArn' - License ARN.
--
-- 'status', 'createLicenseVersionResponse_status' - License status.
--
-- 'version', 'createLicenseVersionResponse_version' - New version of the license.
--
-- 'httpStatus', 'createLicenseVersionResponse_httpStatus' - The response's http status code.
newCreateLicenseVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLicenseVersionResponse
newCreateLicenseVersionResponse :: Int -> CreateLicenseVersionResponse
newCreateLicenseVersionResponse Int
pHttpStatus_ =
  CreateLicenseVersionResponse'
    { $sel:licenseArn:CreateLicenseVersionResponse' :: Maybe Text
licenseArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateLicenseVersionResponse' :: Maybe LicenseStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateLicenseVersionResponse' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLicenseVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | License ARN.
createLicenseVersionResponse_licenseArn :: Lens.Lens' CreateLicenseVersionResponse (Prelude.Maybe Prelude.Text)
createLicenseVersionResponse_licenseArn :: Lens' CreateLicenseVersionResponse (Maybe Text)
createLicenseVersionResponse_licenseArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersionResponse' {Maybe Text
licenseArn :: Maybe Text
$sel:licenseArn:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe Text
licenseArn} -> Maybe Text
licenseArn) (\s :: CreateLicenseVersionResponse
s@CreateLicenseVersionResponse' {} Maybe Text
a -> CreateLicenseVersionResponse
s {$sel:licenseArn:CreateLicenseVersionResponse' :: Maybe Text
licenseArn = Maybe Text
a} :: CreateLicenseVersionResponse)

-- | License status.
createLicenseVersionResponse_status :: Lens.Lens' CreateLicenseVersionResponse (Prelude.Maybe LicenseStatus)
createLicenseVersionResponse_status :: Lens' CreateLicenseVersionResponse (Maybe LicenseStatus)
createLicenseVersionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersionResponse' {Maybe LicenseStatus
status :: Maybe LicenseStatus
$sel:status:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe LicenseStatus
status} -> Maybe LicenseStatus
status) (\s :: CreateLicenseVersionResponse
s@CreateLicenseVersionResponse' {} Maybe LicenseStatus
a -> CreateLicenseVersionResponse
s {$sel:status:CreateLicenseVersionResponse' :: Maybe LicenseStatus
status = Maybe LicenseStatus
a} :: CreateLicenseVersionResponse)

-- | New version of the license.
createLicenseVersionResponse_version :: Lens.Lens' CreateLicenseVersionResponse (Prelude.Maybe Prelude.Text)
createLicenseVersionResponse_version :: Lens' CreateLicenseVersionResponse (Maybe Text)
createLicenseVersionResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseVersionResponse' {Maybe Text
version :: Maybe Text
$sel:version:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe Text
version} -> Maybe Text
version) (\s :: CreateLicenseVersionResponse
s@CreateLicenseVersionResponse' {} Maybe Text
a -> CreateLicenseVersionResponse
s {$sel:version:CreateLicenseVersionResponse' :: Maybe Text
version = Maybe Text
a} :: CreateLicenseVersionResponse)

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

instance Prelude.NFData CreateLicenseVersionResponse where
  rnf :: CreateLicenseVersionResponse -> ()
rnf CreateLicenseVersionResponse' {Int
Maybe Text
Maybe LicenseStatus
httpStatus :: Int
version :: Maybe Text
status :: Maybe LicenseStatus
licenseArn :: Maybe Text
$sel:httpStatus:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Int
$sel:version:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe Text
$sel:status:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe LicenseStatus
$sel:licenseArn:CreateLicenseVersionResponse' :: CreateLicenseVersionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LicenseStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus