{-# 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.CheckInLicense
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Checks in the specified license. Check in a license when it is no longer
-- in use.
module Amazonka.LicenseManager.CheckInLicense
  ( -- * Creating a Request
    CheckInLicense (..),
    newCheckInLicense,

    -- * Request Lenses
    checkInLicense_beneficiary,
    checkInLicense_licenseConsumptionToken,

    -- * Destructuring the Response
    CheckInLicenseResponse (..),
    newCheckInLicenseResponse,

    -- * Response Lenses
    checkInLicenseResponse_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:/ 'newCheckInLicense' smart constructor.
data CheckInLicense = CheckInLicense'
  { -- | License beneficiary.
    CheckInLicense -> Maybe Text
beneficiary :: Prelude.Maybe Prelude.Text,
    -- | License consumption token.
    CheckInLicense -> Text
licenseConsumptionToken :: Prelude.Text
  }
  deriving (CheckInLicense -> CheckInLicense -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckInLicense -> CheckInLicense -> Bool
$c/= :: CheckInLicense -> CheckInLicense -> Bool
== :: CheckInLicense -> CheckInLicense -> Bool
$c== :: CheckInLicense -> CheckInLicense -> Bool
Prelude.Eq, ReadPrec [CheckInLicense]
ReadPrec CheckInLicense
Int -> ReadS CheckInLicense
ReadS [CheckInLicense]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckInLicense]
$creadListPrec :: ReadPrec [CheckInLicense]
readPrec :: ReadPrec CheckInLicense
$creadPrec :: ReadPrec CheckInLicense
readList :: ReadS [CheckInLicense]
$creadList :: ReadS [CheckInLicense]
readsPrec :: Int -> ReadS CheckInLicense
$creadsPrec :: Int -> ReadS CheckInLicense
Prelude.Read, Int -> CheckInLicense -> ShowS
[CheckInLicense] -> ShowS
CheckInLicense -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckInLicense] -> ShowS
$cshowList :: [CheckInLicense] -> ShowS
show :: CheckInLicense -> String
$cshow :: CheckInLicense -> String
showsPrec :: Int -> CheckInLicense -> ShowS
$cshowsPrec :: Int -> CheckInLicense -> ShowS
Prelude.Show, forall x. Rep CheckInLicense x -> CheckInLicense
forall x. CheckInLicense -> Rep CheckInLicense x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckInLicense x -> CheckInLicense
$cfrom :: forall x. CheckInLicense -> Rep CheckInLicense x
Prelude.Generic)

-- |
-- Create a value of 'CheckInLicense' 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:
--
-- 'beneficiary', 'checkInLicense_beneficiary' - License beneficiary.
--
-- 'licenseConsumptionToken', 'checkInLicense_licenseConsumptionToken' - License consumption token.
newCheckInLicense ::
  -- | 'licenseConsumptionToken'
  Prelude.Text ->
  CheckInLicense
newCheckInLicense :: Text -> CheckInLicense
newCheckInLicense Text
pLicenseConsumptionToken_ =
  CheckInLicense'
    { $sel:beneficiary:CheckInLicense' :: Maybe Text
beneficiary = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseConsumptionToken:CheckInLicense' :: Text
licenseConsumptionToken = Text
pLicenseConsumptionToken_
    }

-- | License beneficiary.
checkInLicense_beneficiary :: Lens.Lens' CheckInLicense (Prelude.Maybe Prelude.Text)
checkInLicense_beneficiary :: Lens' CheckInLicense (Maybe Text)
checkInLicense_beneficiary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckInLicense' {Maybe Text
beneficiary :: Maybe Text
$sel:beneficiary:CheckInLicense' :: CheckInLicense -> Maybe Text
beneficiary} -> Maybe Text
beneficiary) (\s :: CheckInLicense
s@CheckInLicense' {} Maybe Text
a -> CheckInLicense
s {$sel:beneficiary:CheckInLicense' :: Maybe Text
beneficiary = Maybe Text
a} :: CheckInLicense)

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

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

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

instance Data.ToHeaders CheckInLicense where
  toHeaders :: CheckInLicense -> 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.CheckInLicense" ::
                          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 CheckInLicense where
  toJSON :: CheckInLicense -> Value
toJSON CheckInLicense' {Maybe Text
Text
licenseConsumptionToken :: Text
beneficiary :: Maybe Text
$sel:licenseConsumptionToken:CheckInLicense' :: CheckInLicense -> Text
$sel:beneficiary:CheckInLicense' :: CheckInLicense -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Beneficiary" 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
beneficiary,
            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 CheckInLicense where
  toPath :: CheckInLicense -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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