{-# 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.ExtendLicenseConsumption
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Extends the expiration date for license consumption.
module Amazonka.LicenseManager.ExtendLicenseConsumption
  ( -- * Creating a Request
    ExtendLicenseConsumption (..),
    newExtendLicenseConsumption,

    -- * Request Lenses
    extendLicenseConsumption_dryRun,
    extendLicenseConsumption_licenseConsumptionToken,

    -- * Destructuring the Response
    ExtendLicenseConsumptionResponse (..),
    newExtendLicenseConsumptionResponse,

    -- * Response Lenses
    extendLicenseConsumptionResponse_expiration,
    extendLicenseConsumptionResponse_licenseConsumptionToken,
    extendLicenseConsumptionResponse_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:/ 'newExtendLicenseConsumption' smart constructor.
data ExtendLicenseConsumption = ExtendLicenseConsumption'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request. Provides an error response if you do not
    -- have the required permissions.
    ExtendLicenseConsumption -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | License consumption token.
    ExtendLicenseConsumption -> Text
licenseConsumptionToken :: Prelude.Text
  }
  deriving (ExtendLicenseConsumption -> ExtendLicenseConsumption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendLicenseConsumption -> ExtendLicenseConsumption -> Bool
$c/= :: ExtendLicenseConsumption -> ExtendLicenseConsumption -> Bool
== :: ExtendLicenseConsumption -> ExtendLicenseConsumption -> Bool
$c== :: ExtendLicenseConsumption -> ExtendLicenseConsumption -> Bool
Prelude.Eq, ReadPrec [ExtendLicenseConsumption]
ReadPrec ExtendLicenseConsumption
Int -> ReadS ExtendLicenseConsumption
ReadS [ExtendLicenseConsumption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExtendLicenseConsumption]
$creadListPrec :: ReadPrec [ExtendLicenseConsumption]
readPrec :: ReadPrec ExtendLicenseConsumption
$creadPrec :: ReadPrec ExtendLicenseConsumption
readList :: ReadS [ExtendLicenseConsumption]
$creadList :: ReadS [ExtendLicenseConsumption]
readsPrec :: Int -> ReadS ExtendLicenseConsumption
$creadsPrec :: Int -> ReadS ExtendLicenseConsumption
Prelude.Read, Int -> ExtendLicenseConsumption -> ShowS
[ExtendLicenseConsumption] -> ShowS
ExtendLicenseConsumption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendLicenseConsumption] -> ShowS
$cshowList :: [ExtendLicenseConsumption] -> ShowS
show :: ExtendLicenseConsumption -> String
$cshow :: ExtendLicenseConsumption -> String
showsPrec :: Int -> ExtendLicenseConsumption -> ShowS
$cshowsPrec :: Int -> ExtendLicenseConsumption -> ShowS
Prelude.Show, forall x.
Rep ExtendLicenseConsumption x -> ExtendLicenseConsumption
forall x.
ExtendLicenseConsumption -> Rep ExtendLicenseConsumption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExtendLicenseConsumption x -> ExtendLicenseConsumption
$cfrom :: forall x.
ExtendLicenseConsumption -> Rep ExtendLicenseConsumption x
Prelude.Generic)

-- |
-- Create a value of 'ExtendLicenseConsumption' 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:
--
-- 'dryRun', 'extendLicenseConsumption_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request. Provides an error response if you do not
-- have the required permissions.
--
-- 'licenseConsumptionToken', 'extendLicenseConsumption_licenseConsumptionToken' - License consumption token.
newExtendLicenseConsumption ::
  -- | 'licenseConsumptionToken'
  Prelude.Text ->
  ExtendLicenseConsumption
newExtendLicenseConsumption :: Text -> ExtendLicenseConsumption
newExtendLicenseConsumption Text
pLicenseConsumptionToken_ =
  ExtendLicenseConsumption'
    { $sel:dryRun:ExtendLicenseConsumption' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseConsumptionToken:ExtendLicenseConsumption' :: Text
licenseConsumptionToken =
        Text
pLicenseConsumptionToken_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request. Provides an error response if you do not
-- have the required permissions.
extendLicenseConsumption_dryRun :: Lens.Lens' ExtendLicenseConsumption (Prelude.Maybe Prelude.Bool)
extendLicenseConsumption_dryRun :: Lens' ExtendLicenseConsumption (Maybe Bool)
extendLicenseConsumption_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExtendLicenseConsumption' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ExtendLicenseConsumption
s@ExtendLicenseConsumption' {} Maybe Bool
a -> ExtendLicenseConsumption
s {$sel:dryRun:ExtendLicenseConsumption' :: Maybe Bool
dryRun = Maybe Bool
a} :: ExtendLicenseConsumption)

-- | License consumption token.
extendLicenseConsumption_licenseConsumptionToken :: Lens.Lens' ExtendLicenseConsumption Prelude.Text
extendLicenseConsumption_licenseConsumptionToken :: Lens' ExtendLicenseConsumption Text
extendLicenseConsumption_licenseConsumptionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExtendLicenseConsumption' {Text
licenseConsumptionToken :: Text
$sel:licenseConsumptionToken:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Text
licenseConsumptionToken} -> Text
licenseConsumptionToken) (\s :: ExtendLicenseConsumption
s@ExtendLicenseConsumption' {} Text
a -> ExtendLicenseConsumption
s {$sel:licenseConsumptionToken:ExtendLicenseConsumption' :: Text
licenseConsumptionToken = Text
a} :: ExtendLicenseConsumption)

instance Core.AWSRequest ExtendLicenseConsumption where
  type
    AWSResponse ExtendLicenseConsumption =
      ExtendLicenseConsumptionResponse
  request :: (Service -> Service)
-> ExtendLicenseConsumption -> Request ExtendLicenseConsumption
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 ExtendLicenseConsumption
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ExtendLicenseConsumption)))
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 Text -> Int -> ExtendLicenseConsumptionResponse
ExtendLicenseConsumptionResponse'
            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
"Expiration")
            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
"LicenseConsumptionToken")
            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 ExtendLicenseConsumption where
  hashWithSalt :: Int -> ExtendLicenseConsumption -> Int
hashWithSalt Int
_salt ExtendLicenseConsumption' {Maybe Bool
Text
licenseConsumptionToken :: Text
dryRun :: Maybe Bool
$sel:licenseConsumptionToken:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Text
$sel:dryRun:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
licenseConsumptionToken

instance Prelude.NFData ExtendLicenseConsumption where
  rnf :: ExtendLicenseConsumption -> ()
rnf ExtendLicenseConsumption' {Maybe Bool
Text
licenseConsumptionToken :: Text
dryRun :: Maybe Bool
$sel:licenseConsumptionToken:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Text
$sel:dryRun:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
licenseConsumptionToken

instance Data.ToHeaders ExtendLicenseConsumption where
  toHeaders :: ExtendLicenseConsumption -> 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.ExtendLicenseConsumption" ::
                          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 ExtendLicenseConsumption where
  toJSON :: ExtendLicenseConsumption -> Value
toJSON ExtendLicenseConsumption' {Maybe Bool
Text
licenseConsumptionToken :: Text
dryRun :: Maybe Bool
$sel:licenseConsumptionToken:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Text
$sel:dryRun:ExtendLicenseConsumption' :: ExtendLicenseConsumption -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DryRun" 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 Bool
dryRun,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"LicenseConsumptionToken"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
licenseConsumptionToken
              )
          ]
      )

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

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

-- | /See:/ 'newExtendLicenseConsumptionResponse' smart constructor.
data ExtendLicenseConsumptionResponse = ExtendLicenseConsumptionResponse'
  { -- | Date and time at which the license consumption expires.
    ExtendLicenseConsumptionResponse -> Maybe Text
expiration :: Prelude.Maybe Prelude.Text,
    -- | License consumption token.
    ExtendLicenseConsumptionResponse -> Maybe Text
licenseConsumptionToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExtendLicenseConsumptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExtendLicenseConsumptionResponse
-> ExtendLicenseConsumptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendLicenseConsumptionResponse
-> ExtendLicenseConsumptionResponse -> Bool
$c/= :: ExtendLicenseConsumptionResponse
-> ExtendLicenseConsumptionResponse -> Bool
== :: ExtendLicenseConsumptionResponse
-> ExtendLicenseConsumptionResponse -> Bool
$c== :: ExtendLicenseConsumptionResponse
-> ExtendLicenseConsumptionResponse -> Bool
Prelude.Eq, ReadPrec [ExtendLicenseConsumptionResponse]
ReadPrec ExtendLicenseConsumptionResponse
Int -> ReadS ExtendLicenseConsumptionResponse
ReadS [ExtendLicenseConsumptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExtendLicenseConsumptionResponse]
$creadListPrec :: ReadPrec [ExtendLicenseConsumptionResponse]
readPrec :: ReadPrec ExtendLicenseConsumptionResponse
$creadPrec :: ReadPrec ExtendLicenseConsumptionResponse
readList :: ReadS [ExtendLicenseConsumptionResponse]
$creadList :: ReadS [ExtendLicenseConsumptionResponse]
readsPrec :: Int -> ReadS ExtendLicenseConsumptionResponse
$creadsPrec :: Int -> ReadS ExtendLicenseConsumptionResponse
Prelude.Read, Int -> ExtendLicenseConsumptionResponse -> ShowS
[ExtendLicenseConsumptionResponse] -> ShowS
ExtendLicenseConsumptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendLicenseConsumptionResponse] -> ShowS
$cshowList :: [ExtendLicenseConsumptionResponse] -> ShowS
show :: ExtendLicenseConsumptionResponse -> String
$cshow :: ExtendLicenseConsumptionResponse -> String
showsPrec :: Int -> ExtendLicenseConsumptionResponse -> ShowS
$cshowsPrec :: Int -> ExtendLicenseConsumptionResponse -> ShowS
Prelude.Show, forall x.
Rep ExtendLicenseConsumptionResponse x
-> ExtendLicenseConsumptionResponse
forall x.
ExtendLicenseConsumptionResponse
-> Rep ExtendLicenseConsumptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExtendLicenseConsumptionResponse x
-> ExtendLicenseConsumptionResponse
$cfrom :: forall x.
ExtendLicenseConsumptionResponse
-> Rep ExtendLicenseConsumptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExtendLicenseConsumptionResponse' 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:
--
-- 'expiration', 'extendLicenseConsumptionResponse_expiration' - Date and time at which the license consumption expires.
--
-- 'licenseConsumptionToken', 'extendLicenseConsumptionResponse_licenseConsumptionToken' - License consumption token.
--
-- 'httpStatus', 'extendLicenseConsumptionResponse_httpStatus' - The response's http status code.
newExtendLicenseConsumptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExtendLicenseConsumptionResponse
newExtendLicenseConsumptionResponse :: Int -> ExtendLicenseConsumptionResponse
newExtendLicenseConsumptionResponse Int
pHttpStatus_ =
  ExtendLicenseConsumptionResponse'
    { $sel:expiration:ExtendLicenseConsumptionResponse' :: Maybe Text
expiration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:licenseConsumptionToken:ExtendLicenseConsumptionResponse' :: Maybe Text
licenseConsumptionToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExtendLicenseConsumptionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Date and time at which the license consumption expires.
extendLicenseConsumptionResponse_expiration :: Lens.Lens' ExtendLicenseConsumptionResponse (Prelude.Maybe Prelude.Text)
extendLicenseConsumptionResponse_expiration :: Lens' ExtendLicenseConsumptionResponse (Maybe Text)
extendLicenseConsumptionResponse_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExtendLicenseConsumptionResponse' {Maybe Text
expiration :: Maybe Text
$sel:expiration:ExtendLicenseConsumptionResponse' :: ExtendLicenseConsumptionResponse -> Maybe Text
expiration} -> Maybe Text
expiration) (\s :: ExtendLicenseConsumptionResponse
s@ExtendLicenseConsumptionResponse' {} Maybe Text
a -> ExtendLicenseConsumptionResponse
s {$sel:expiration:ExtendLicenseConsumptionResponse' :: Maybe Text
expiration = Maybe Text
a} :: ExtendLicenseConsumptionResponse)

-- | License consumption token.
extendLicenseConsumptionResponse_licenseConsumptionToken :: Lens.Lens' ExtendLicenseConsumptionResponse (Prelude.Maybe Prelude.Text)
extendLicenseConsumptionResponse_licenseConsumptionToken :: Lens' ExtendLicenseConsumptionResponse (Maybe Text)
extendLicenseConsumptionResponse_licenseConsumptionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExtendLicenseConsumptionResponse' {Maybe Text
licenseConsumptionToken :: Maybe Text
$sel:licenseConsumptionToken:ExtendLicenseConsumptionResponse' :: ExtendLicenseConsumptionResponse -> Maybe Text
licenseConsumptionToken} -> Maybe Text
licenseConsumptionToken) (\s :: ExtendLicenseConsumptionResponse
s@ExtendLicenseConsumptionResponse' {} Maybe Text
a -> ExtendLicenseConsumptionResponse
s {$sel:licenseConsumptionToken:ExtendLicenseConsumptionResponse' :: Maybe Text
licenseConsumptionToken = Maybe Text
a} :: ExtendLicenseConsumptionResponse)

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

instance
  Prelude.NFData
    ExtendLicenseConsumptionResponse
  where
  rnf :: ExtendLicenseConsumptionResponse -> ()
rnf ExtendLicenseConsumptionResponse' {Int
Maybe Text
httpStatus :: Int
licenseConsumptionToken :: Maybe Text
expiration :: Maybe Text
$sel:httpStatus:ExtendLicenseConsumptionResponse' :: ExtendLicenseConsumptionResponse -> Int
$sel:licenseConsumptionToken:ExtendLicenseConsumptionResponse' :: ExtendLicenseConsumptionResponse -> Maybe Text
$sel:expiration:ExtendLicenseConsumptionResponse' :: ExtendLicenseConsumptionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expiration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseConsumptionToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus