{-# 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.GetLicense
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets detailed information about the specified license.
module Amazonka.LicenseManager.GetLicense
  ( -- * Creating a Request
    GetLicense (..),
    newGetLicense,

    -- * Request Lenses
    getLicense_version,
    getLicense_licenseArn,

    -- * Destructuring the Response
    GetLicenseResponse (..),
    newGetLicenseResponse,

    -- * Response Lenses
    getLicenseResponse_license,
    getLicenseResponse_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:/ 'newGetLicense' smart constructor.
data GetLicense = GetLicense'
  { -- | License version.
    GetLicense -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
    -- | Amazon Resource Name (ARN) of the license.
    GetLicense -> Text
licenseArn :: Prelude.Text
  }
  deriving (GetLicense -> GetLicense -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLicense -> GetLicense -> Bool
$c/= :: GetLicense -> GetLicense -> Bool
== :: GetLicense -> GetLicense -> Bool
$c== :: GetLicense -> GetLicense -> Bool
Prelude.Eq, ReadPrec [GetLicense]
ReadPrec GetLicense
Int -> ReadS GetLicense
ReadS [GetLicense]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLicense]
$creadListPrec :: ReadPrec [GetLicense]
readPrec :: ReadPrec GetLicense
$creadPrec :: ReadPrec GetLicense
readList :: ReadS [GetLicense]
$creadList :: ReadS [GetLicense]
readsPrec :: Int -> ReadS GetLicense
$creadsPrec :: Int -> ReadS GetLicense
Prelude.Read, Int -> GetLicense -> ShowS
[GetLicense] -> ShowS
GetLicense -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLicense] -> ShowS
$cshowList :: [GetLicense] -> ShowS
show :: GetLicense -> String
$cshow :: GetLicense -> String
showsPrec :: Int -> GetLicense -> ShowS
$cshowsPrec :: Int -> GetLicense -> ShowS
Prelude.Show, forall x. Rep GetLicense x -> GetLicense
forall x. GetLicense -> Rep GetLicense x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLicense x -> GetLicense
$cfrom :: forall x. GetLicense -> Rep GetLicense x
Prelude.Generic)

-- |
-- Create a value of 'GetLicense' 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:
--
-- 'version', 'getLicense_version' - License version.
--
-- 'licenseArn', 'getLicense_licenseArn' - Amazon Resource Name (ARN) of the license.
newGetLicense ::
  -- | 'licenseArn'
  Prelude.Text ->
  GetLicense
newGetLicense :: Text -> GetLicense
newGetLicense Text
pLicenseArn_ =
  GetLicense'
    { $sel:version:GetLicense' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseArn:GetLicense' :: Text
licenseArn = Text
pLicenseArn_
    }

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

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

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

instance Prelude.NFData GetLicense where
  rnf :: GetLicense -> ()
rnf GetLicense' {Maybe Text
Text
licenseArn :: Text
version :: Maybe Text
$sel:licenseArn:GetLicense' :: GetLicense -> Text
$sel:version:GetLicense' :: GetLicense -> Maybe Text
..} =
    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 Text
licenseArn

instance Data.ToHeaders GetLicense where
  toHeaders :: GetLicense -> 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.GetLicense" ::
                          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 GetLicense where
  toJSON :: GetLicense -> Value
toJSON GetLicense' {Maybe Text
Text
licenseArn :: Text
version :: Maybe Text
$sel:licenseArn:GetLicense' :: GetLicense -> Text
$sel:version:GetLicense' :: GetLicense -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Version" 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
version,
            forall a. a -> Maybe a
Prelude.Just (Key
"LicenseArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
licenseArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'GetLicenseResponse' 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:
--
-- 'license', 'getLicenseResponse_license' - License details.
--
-- 'httpStatus', 'getLicenseResponse_httpStatus' - The response's http status code.
newGetLicenseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLicenseResponse
newGetLicenseResponse :: Int -> GetLicenseResponse
newGetLicenseResponse Int
pHttpStatus_ =
  GetLicenseResponse'
    { $sel:license:GetLicenseResponse' :: Maybe License
license = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLicenseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | License details.
getLicenseResponse_license :: Lens.Lens' GetLicenseResponse (Prelude.Maybe License)
getLicenseResponse_license :: Lens' GetLicenseResponse (Maybe License)
getLicenseResponse_license = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLicenseResponse' {Maybe License
license :: Maybe License
$sel:license:GetLicenseResponse' :: GetLicenseResponse -> Maybe License
license} -> Maybe License
license) (\s :: GetLicenseResponse
s@GetLicenseResponse' {} Maybe License
a -> GetLicenseResponse
s {$sel:license:GetLicenseResponse' :: Maybe License
license = Maybe License
a} :: GetLicenseResponse)

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

instance Prelude.NFData GetLicenseResponse where
  rnf :: GetLicenseResponse -> ()
rnf GetLicenseResponse' {Int
Maybe License
httpStatus :: Int
license :: Maybe License
$sel:httpStatus:GetLicenseResponse' :: GetLicenseResponse -> Int
$sel:license:GetLicenseResponse' :: GetLicenseResponse -> Maybe License
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe License
license
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus