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

    -- * Request Lenses
    deleteLicense_licenseArn,
    deleteLicense_sourceVersion,

    -- * Destructuring the Response
    DeleteLicenseResponse (..),
    newDeleteLicenseResponse,

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

-- |
-- Create a value of 'DeleteLicense' 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', 'deleteLicense_licenseArn' - Amazon Resource Name (ARN) of the license.
--
-- 'sourceVersion', 'deleteLicense_sourceVersion' - Current version of the license.
newDeleteLicense ::
  -- | 'licenseArn'
  Prelude.Text ->
  -- | 'sourceVersion'
  Prelude.Text ->
  DeleteLicense
newDeleteLicense :: Text -> Text -> DeleteLicense
newDeleteLicense Text
pLicenseArn_ Text
pSourceVersion_ =
  DeleteLicense'
    { $sel:licenseArn:DeleteLicense' :: Text
licenseArn = Text
pLicenseArn_,
      $sel:sourceVersion:DeleteLicense' :: Text
sourceVersion = Text
pSourceVersion_
    }

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

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

instance Core.AWSRequest DeleteLicense where
  type
    AWSResponse DeleteLicense =
      DeleteLicenseResponse
  request :: (Service -> Service) -> DeleteLicense -> Request DeleteLicense
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 DeleteLicense
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteLicense)))
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 LicenseDeletionStatus -> Int -> DeleteLicenseResponse
DeleteLicenseResponse'
            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
"DeletionDate")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DeleteLicense where
  hashWithSalt :: Int -> DeleteLicense -> Int
hashWithSalt Int
_salt DeleteLicense' {Text
sourceVersion :: Text
licenseArn :: Text
$sel:sourceVersion:DeleteLicense' :: DeleteLicense -> Text
$sel:licenseArn:DeleteLicense' :: DeleteLicense -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
licenseArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceVersion

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

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

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

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

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

-- |
-- Create a value of 'DeleteLicenseResponse' 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:
--
-- 'deletionDate', 'deleteLicenseResponse_deletionDate' - Date when the license is deleted.
--
-- 'status', 'deleteLicenseResponse_status' - License status.
--
-- 'httpStatus', 'deleteLicenseResponse_httpStatus' - The response's http status code.
newDeleteLicenseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteLicenseResponse
newDeleteLicenseResponse :: Int -> DeleteLicenseResponse
newDeleteLicenseResponse Int
pHttpStatus_ =
  DeleteLicenseResponse'
    { $sel:deletionDate:DeleteLicenseResponse' :: Maybe Text
deletionDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:DeleteLicenseResponse' :: Maybe LicenseDeletionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteLicenseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Date when the license is deleted.
deleteLicenseResponse_deletionDate :: Lens.Lens' DeleteLicenseResponse (Prelude.Maybe Prelude.Text)
deleteLicenseResponse_deletionDate :: Lens' DeleteLicenseResponse (Maybe Text)
deleteLicenseResponse_deletionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLicenseResponse' {Maybe Text
deletionDate :: Maybe Text
$sel:deletionDate:DeleteLicenseResponse' :: DeleteLicenseResponse -> Maybe Text
deletionDate} -> Maybe Text
deletionDate) (\s :: DeleteLicenseResponse
s@DeleteLicenseResponse' {} Maybe Text
a -> DeleteLicenseResponse
s {$sel:deletionDate:DeleteLicenseResponse' :: Maybe Text
deletionDate = Maybe Text
a} :: DeleteLicenseResponse)

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

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

instance Prelude.NFData DeleteLicenseResponse where
  rnf :: DeleteLicenseResponse -> ()
rnf DeleteLicenseResponse' {Int
Maybe Text
Maybe LicenseDeletionStatus
httpStatus :: Int
status :: Maybe LicenseDeletionStatus
deletionDate :: Maybe Text
$sel:httpStatus:DeleteLicenseResponse' :: DeleteLicenseResponse -> Int
$sel:status:DeleteLicenseResponse' :: DeleteLicenseResponse -> Maybe LicenseDeletionStatus
$sel:deletionDate:DeleteLicenseResponse' :: DeleteLicenseResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deletionDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LicenseDeletionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus