{-# 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.SSM.DeleteInventory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete a custom inventory type or the data associated with a custom
-- Inventory type. Deleting a custom inventory type is also referred to as
-- deleting a custom inventory schema.
module Amazonka.SSM.DeleteInventory
  ( -- * Creating a Request
    DeleteInventory (..),
    newDeleteInventory,

    -- * Request Lenses
    deleteInventory_clientToken,
    deleteInventory_dryRun,
    deleteInventory_schemaDeleteOption,
    deleteInventory_typeName,

    -- * Destructuring the Response
    DeleteInventoryResponse (..),
    newDeleteInventoryResponse,

    -- * Response Lenses
    deleteInventoryResponse_deletionId,
    deleteInventoryResponse_deletionSummary,
    deleteInventoryResponse_typeName,
    deleteInventoryResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteInventory' smart constructor.
data DeleteInventory = DeleteInventory'
  { -- | User-provided idempotency token.
    DeleteInventory -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Use this option to view a summary of the deletion request without
    -- deleting any data or the data type. This option is useful when you only
    -- want to understand what will be deleted. Once you validate that the data
    -- to be deleted is what you intend to delete, you can run the same command
    -- without specifying the @DryRun@ option.
    DeleteInventory -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Use the @SchemaDeleteOption@ to delete a custom inventory type (schema).
    -- If you don\'t choose this option, the system only deletes existing
    -- inventory data associated with the custom inventory type. Choose one of
    -- the following options:
    --
    -- DisableSchema: If you choose this option, the system ignores all
    -- inventory data for the specified version, and any earlier versions. To
    -- enable this schema again, you must call the @PutInventory@ operation for
    -- a version greater than the disabled version.
    --
    -- DeleteSchema: This option deletes the specified custom type from the
    -- Inventory service. You can recreate the schema later, if you want.
    DeleteInventory -> Maybe InventorySchemaDeleteOption
schemaDeleteOption :: Prelude.Maybe InventorySchemaDeleteOption,
    -- | The name of the custom inventory type for which you want to delete
    -- either all previously collected data or the inventory type itself.
    DeleteInventory -> Text
typeName :: Prelude.Text
  }
  deriving (DeleteInventory -> DeleteInventory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInventory -> DeleteInventory -> Bool
$c/= :: DeleteInventory -> DeleteInventory -> Bool
== :: DeleteInventory -> DeleteInventory -> Bool
$c== :: DeleteInventory -> DeleteInventory -> Bool
Prelude.Eq, ReadPrec [DeleteInventory]
ReadPrec DeleteInventory
Int -> ReadS DeleteInventory
ReadS [DeleteInventory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInventory]
$creadListPrec :: ReadPrec [DeleteInventory]
readPrec :: ReadPrec DeleteInventory
$creadPrec :: ReadPrec DeleteInventory
readList :: ReadS [DeleteInventory]
$creadList :: ReadS [DeleteInventory]
readsPrec :: Int -> ReadS DeleteInventory
$creadsPrec :: Int -> ReadS DeleteInventory
Prelude.Read, Int -> DeleteInventory -> ShowS
[DeleteInventory] -> ShowS
DeleteInventory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInventory] -> ShowS
$cshowList :: [DeleteInventory] -> ShowS
show :: DeleteInventory -> String
$cshow :: DeleteInventory -> String
showsPrec :: Int -> DeleteInventory -> ShowS
$cshowsPrec :: Int -> DeleteInventory -> ShowS
Prelude.Show, forall x. Rep DeleteInventory x -> DeleteInventory
forall x. DeleteInventory -> Rep DeleteInventory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteInventory x -> DeleteInventory
$cfrom :: forall x. DeleteInventory -> Rep DeleteInventory x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInventory' 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:
--
-- 'clientToken', 'deleteInventory_clientToken' - User-provided idempotency token.
--
-- 'dryRun', 'deleteInventory_dryRun' - Use this option to view a summary of the deletion request without
-- deleting any data or the data type. This option is useful when you only
-- want to understand what will be deleted. Once you validate that the data
-- to be deleted is what you intend to delete, you can run the same command
-- without specifying the @DryRun@ option.
--
-- 'schemaDeleteOption', 'deleteInventory_schemaDeleteOption' - Use the @SchemaDeleteOption@ to delete a custom inventory type (schema).
-- If you don\'t choose this option, the system only deletes existing
-- inventory data associated with the custom inventory type. Choose one of
-- the following options:
--
-- DisableSchema: If you choose this option, the system ignores all
-- inventory data for the specified version, and any earlier versions. To
-- enable this schema again, you must call the @PutInventory@ operation for
-- a version greater than the disabled version.
--
-- DeleteSchema: This option deletes the specified custom type from the
-- Inventory service. You can recreate the schema later, if you want.
--
-- 'typeName', 'deleteInventory_typeName' - The name of the custom inventory type for which you want to delete
-- either all previously collected data or the inventory type itself.
newDeleteInventory ::
  -- | 'typeName'
  Prelude.Text ->
  DeleteInventory
newDeleteInventory :: Text -> DeleteInventory
newDeleteInventory Text
pTypeName_ =
  DeleteInventory'
    { $sel:clientToken:DeleteInventory' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:DeleteInventory' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaDeleteOption:DeleteInventory' :: Maybe InventorySchemaDeleteOption
schemaDeleteOption = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:DeleteInventory' :: Text
typeName = Text
pTypeName_
    }

-- | User-provided idempotency token.
deleteInventory_clientToken :: Lens.Lens' DeleteInventory (Prelude.Maybe Prelude.Text)
deleteInventory_clientToken :: Lens' DeleteInventory (Maybe Text)
deleteInventory_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventory' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:DeleteInventory' :: DeleteInventory -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: DeleteInventory
s@DeleteInventory' {} Maybe Text
a -> DeleteInventory
s {$sel:clientToken:DeleteInventory' :: Maybe Text
clientToken = Maybe Text
a} :: DeleteInventory)

-- | Use this option to view a summary of the deletion request without
-- deleting any data or the data type. This option is useful when you only
-- want to understand what will be deleted. Once you validate that the data
-- to be deleted is what you intend to delete, you can run the same command
-- without specifying the @DryRun@ option.
deleteInventory_dryRun :: Lens.Lens' DeleteInventory (Prelude.Maybe Prelude.Bool)
deleteInventory_dryRun :: Lens' DeleteInventory (Maybe Bool)
deleteInventory_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventory' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteInventory' :: DeleteInventory -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DeleteInventory
s@DeleteInventory' {} Maybe Bool
a -> DeleteInventory
s {$sel:dryRun:DeleteInventory' :: Maybe Bool
dryRun = Maybe Bool
a} :: DeleteInventory)

-- | Use the @SchemaDeleteOption@ to delete a custom inventory type (schema).
-- If you don\'t choose this option, the system only deletes existing
-- inventory data associated with the custom inventory type. Choose one of
-- the following options:
--
-- DisableSchema: If you choose this option, the system ignores all
-- inventory data for the specified version, and any earlier versions. To
-- enable this schema again, you must call the @PutInventory@ operation for
-- a version greater than the disabled version.
--
-- DeleteSchema: This option deletes the specified custom type from the
-- Inventory service. You can recreate the schema later, if you want.
deleteInventory_schemaDeleteOption :: Lens.Lens' DeleteInventory (Prelude.Maybe InventorySchemaDeleteOption)
deleteInventory_schemaDeleteOption :: Lens' DeleteInventory (Maybe InventorySchemaDeleteOption)
deleteInventory_schemaDeleteOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventory' {Maybe InventorySchemaDeleteOption
schemaDeleteOption :: Maybe InventorySchemaDeleteOption
$sel:schemaDeleteOption:DeleteInventory' :: DeleteInventory -> Maybe InventorySchemaDeleteOption
schemaDeleteOption} -> Maybe InventorySchemaDeleteOption
schemaDeleteOption) (\s :: DeleteInventory
s@DeleteInventory' {} Maybe InventorySchemaDeleteOption
a -> DeleteInventory
s {$sel:schemaDeleteOption:DeleteInventory' :: Maybe InventorySchemaDeleteOption
schemaDeleteOption = Maybe InventorySchemaDeleteOption
a} :: DeleteInventory)

-- | The name of the custom inventory type for which you want to delete
-- either all previously collected data or the inventory type itself.
deleteInventory_typeName :: Lens.Lens' DeleteInventory Prelude.Text
deleteInventory_typeName :: Lens' DeleteInventory Text
deleteInventory_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventory' {Text
typeName :: Text
$sel:typeName:DeleteInventory' :: DeleteInventory -> Text
typeName} -> Text
typeName) (\s :: DeleteInventory
s@DeleteInventory' {} Text
a -> DeleteInventory
s {$sel:typeName:DeleteInventory' :: Text
typeName = Text
a} :: DeleteInventory)

instance Core.AWSRequest DeleteInventory where
  type
    AWSResponse DeleteInventory =
      DeleteInventoryResponse
  request :: (Service -> Service) -> DeleteInventory -> Request DeleteInventory
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 DeleteInventory
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteInventory)))
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 InventoryDeletionSummary
-> Maybe Text
-> Int
-> DeleteInventoryResponse
DeleteInventoryResponse'
            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
"DeletionId")
            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
"DeletionSummary")
            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
"TypeName")
            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 DeleteInventory where
  hashWithSalt :: Int -> DeleteInventory -> Int
hashWithSalt Int
_salt DeleteInventory' {Maybe Bool
Maybe Text
Maybe InventorySchemaDeleteOption
Text
typeName :: Text
schemaDeleteOption :: Maybe InventorySchemaDeleteOption
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:typeName:DeleteInventory' :: DeleteInventory -> Text
$sel:schemaDeleteOption:DeleteInventory' :: DeleteInventory -> Maybe InventorySchemaDeleteOption
$sel:dryRun:DeleteInventory' :: DeleteInventory -> Maybe Bool
$sel:clientToken:DeleteInventory' :: DeleteInventory -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InventorySchemaDeleteOption
schemaDeleteOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
typeName

instance Prelude.NFData DeleteInventory where
  rnf :: DeleteInventory -> ()
rnf DeleteInventory' {Maybe Bool
Maybe Text
Maybe InventorySchemaDeleteOption
Text
typeName :: Text
schemaDeleteOption :: Maybe InventorySchemaDeleteOption
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:typeName:DeleteInventory' :: DeleteInventory -> Text
$sel:schemaDeleteOption:DeleteInventory' :: DeleteInventory -> Maybe InventorySchemaDeleteOption
$sel:dryRun:DeleteInventory' :: DeleteInventory -> Maybe Bool
$sel:clientToken:DeleteInventory' :: DeleteInventory -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe InventorySchemaDeleteOption
schemaDeleteOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
typeName

instance Data.ToHeaders DeleteInventory where
  toHeaders :: DeleteInventory -> 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
"AmazonSSM.DeleteInventory" :: 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 DeleteInventory where
  toJSON :: DeleteInventory -> Value
toJSON DeleteInventory' {Maybe Bool
Maybe Text
Maybe InventorySchemaDeleteOption
Text
typeName :: Text
schemaDeleteOption :: Maybe InventorySchemaDeleteOption
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:typeName:DeleteInventory' :: DeleteInventory -> Text
$sel:schemaDeleteOption:DeleteInventory' :: DeleteInventory -> Maybe InventorySchemaDeleteOption
$sel:dryRun:DeleteInventory' :: DeleteInventory -> Maybe Bool
$sel:clientToken:DeleteInventory' :: DeleteInventory -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (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,
            (Key
"SchemaDeleteOption" 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 InventorySchemaDeleteOption
schemaDeleteOption,
            forall a. a -> Maybe a
Prelude.Just (Key
"TypeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
typeName)
          ]
      )

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

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

-- | /See:/ 'newDeleteInventoryResponse' smart constructor.
data DeleteInventoryResponse = DeleteInventoryResponse'
  { -- | Every @DeleteInventory@ operation is assigned a unique ID. This option
    -- returns a unique ID. You can use this ID to query the status of a delete
    -- operation. This option is useful for ensuring that a delete operation
    -- has completed before you begin other operations.
    DeleteInventoryResponse -> Maybe Text
deletionId :: Prelude.Maybe Prelude.Text,
    -- | A summary of the delete operation. For more information about this
    -- summary, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-inventory-custom.html#sysman-inventory-delete-summary Deleting custom inventory>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    DeleteInventoryResponse -> Maybe InventoryDeletionSummary
deletionSummary :: Prelude.Maybe InventoryDeletionSummary,
    -- | The name of the inventory data type specified in the request.
    DeleteInventoryResponse -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteInventoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteInventoryResponse -> DeleteInventoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInventoryResponse -> DeleteInventoryResponse -> Bool
$c/= :: DeleteInventoryResponse -> DeleteInventoryResponse -> Bool
== :: DeleteInventoryResponse -> DeleteInventoryResponse -> Bool
$c== :: DeleteInventoryResponse -> DeleteInventoryResponse -> Bool
Prelude.Eq, ReadPrec [DeleteInventoryResponse]
ReadPrec DeleteInventoryResponse
Int -> ReadS DeleteInventoryResponse
ReadS [DeleteInventoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInventoryResponse]
$creadListPrec :: ReadPrec [DeleteInventoryResponse]
readPrec :: ReadPrec DeleteInventoryResponse
$creadPrec :: ReadPrec DeleteInventoryResponse
readList :: ReadS [DeleteInventoryResponse]
$creadList :: ReadS [DeleteInventoryResponse]
readsPrec :: Int -> ReadS DeleteInventoryResponse
$creadsPrec :: Int -> ReadS DeleteInventoryResponse
Prelude.Read, Int -> DeleteInventoryResponse -> ShowS
[DeleteInventoryResponse] -> ShowS
DeleteInventoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInventoryResponse] -> ShowS
$cshowList :: [DeleteInventoryResponse] -> ShowS
show :: DeleteInventoryResponse -> String
$cshow :: DeleteInventoryResponse -> String
showsPrec :: Int -> DeleteInventoryResponse -> ShowS
$cshowsPrec :: Int -> DeleteInventoryResponse -> ShowS
Prelude.Show, forall x. Rep DeleteInventoryResponse x -> DeleteInventoryResponse
forall x. DeleteInventoryResponse -> Rep DeleteInventoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteInventoryResponse x -> DeleteInventoryResponse
$cfrom :: forall x. DeleteInventoryResponse -> Rep DeleteInventoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInventoryResponse' 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:
--
-- 'deletionId', 'deleteInventoryResponse_deletionId' - Every @DeleteInventory@ operation is assigned a unique ID. This option
-- returns a unique ID. You can use this ID to query the status of a delete
-- operation. This option is useful for ensuring that a delete operation
-- has completed before you begin other operations.
--
-- 'deletionSummary', 'deleteInventoryResponse_deletionSummary' - A summary of the delete operation. For more information about this
-- summary, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-inventory-custom.html#sysman-inventory-delete-summary Deleting custom inventory>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'typeName', 'deleteInventoryResponse_typeName' - The name of the inventory data type specified in the request.
--
-- 'httpStatus', 'deleteInventoryResponse_httpStatus' - The response's http status code.
newDeleteInventoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteInventoryResponse
newDeleteInventoryResponse :: Int -> DeleteInventoryResponse
newDeleteInventoryResponse Int
pHttpStatus_ =
  DeleteInventoryResponse'
    { $sel:deletionId:DeleteInventoryResponse' :: Maybe Text
deletionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deletionSummary:DeleteInventoryResponse' :: Maybe InventoryDeletionSummary
deletionSummary = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:DeleteInventoryResponse' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteInventoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Every @DeleteInventory@ operation is assigned a unique ID. This option
-- returns a unique ID. You can use this ID to query the status of a delete
-- operation. This option is useful for ensuring that a delete operation
-- has completed before you begin other operations.
deleteInventoryResponse_deletionId :: Lens.Lens' DeleteInventoryResponse (Prelude.Maybe Prelude.Text)
deleteInventoryResponse_deletionId :: Lens' DeleteInventoryResponse (Maybe Text)
deleteInventoryResponse_deletionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventoryResponse' {Maybe Text
deletionId :: Maybe Text
$sel:deletionId:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe Text
deletionId} -> Maybe Text
deletionId) (\s :: DeleteInventoryResponse
s@DeleteInventoryResponse' {} Maybe Text
a -> DeleteInventoryResponse
s {$sel:deletionId:DeleteInventoryResponse' :: Maybe Text
deletionId = Maybe Text
a} :: DeleteInventoryResponse)

-- | A summary of the delete operation. For more information about this
-- summary, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-inventory-custom.html#sysman-inventory-delete-summary Deleting custom inventory>
-- in the /Amazon Web Services Systems Manager User Guide/.
deleteInventoryResponse_deletionSummary :: Lens.Lens' DeleteInventoryResponse (Prelude.Maybe InventoryDeletionSummary)
deleteInventoryResponse_deletionSummary :: Lens' DeleteInventoryResponse (Maybe InventoryDeletionSummary)
deleteInventoryResponse_deletionSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventoryResponse' {Maybe InventoryDeletionSummary
deletionSummary :: Maybe InventoryDeletionSummary
$sel:deletionSummary:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe InventoryDeletionSummary
deletionSummary} -> Maybe InventoryDeletionSummary
deletionSummary) (\s :: DeleteInventoryResponse
s@DeleteInventoryResponse' {} Maybe InventoryDeletionSummary
a -> DeleteInventoryResponse
s {$sel:deletionSummary:DeleteInventoryResponse' :: Maybe InventoryDeletionSummary
deletionSummary = Maybe InventoryDeletionSummary
a} :: DeleteInventoryResponse)

-- | The name of the inventory data type specified in the request.
deleteInventoryResponse_typeName :: Lens.Lens' DeleteInventoryResponse (Prelude.Maybe Prelude.Text)
deleteInventoryResponse_typeName :: Lens' DeleteInventoryResponse (Maybe Text)
deleteInventoryResponse_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInventoryResponse' {Maybe Text
typeName :: Maybe Text
$sel:typeName:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: DeleteInventoryResponse
s@DeleteInventoryResponse' {} Maybe Text
a -> DeleteInventoryResponse
s {$sel:typeName:DeleteInventoryResponse' :: Maybe Text
typeName = Maybe Text
a} :: DeleteInventoryResponse)

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

instance Prelude.NFData DeleteInventoryResponse where
  rnf :: DeleteInventoryResponse -> ()
rnf DeleteInventoryResponse' {Int
Maybe Text
Maybe InventoryDeletionSummary
httpStatus :: Int
typeName :: Maybe Text
deletionSummary :: Maybe InventoryDeletionSummary
deletionId :: Maybe Text
$sel:httpStatus:DeleteInventoryResponse' :: DeleteInventoryResponse -> Int
$sel:typeName:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe Text
$sel:deletionSummary:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe InventoryDeletionSummary
$sel:deletionId:DeleteInventoryResponse' :: DeleteInventoryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deletionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InventoryDeletionSummary
deletionSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus