{-# 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.PutComplianceItems
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers a compliance type and other compliance details on a designated
-- resource. This operation lets you register custom compliance details
-- with a resource. This call overwrites existing compliance information on
-- the resource, so you must provide a full list of compliance items each
-- time that you send the request.
--
-- ComplianceType can be one of the following:
--
-- -   ExecutionId: The execution ID when the patch, association, or custom
--     compliance item was applied.
--
-- -   ExecutionType: Specify patch, association, or Custom:@string@.
--
-- -   ExecutionTime. The time the patch, association, or custom compliance
--     item was applied to the managed node.
--
-- -   Id: The patch, association, or custom compliance ID.
--
-- -   Title: A title.
--
-- -   Status: The status of the compliance item. For example, @approved@
--     for patches, or @Failed@ for associations.
--
-- -   Severity: A patch severity. For example, @Critical@.
--
-- -   DocumentName: An SSM document name. For example,
--     @AWS-RunPatchBaseline@.
--
-- -   DocumentVersion: An SSM document version number. For example, 4.
--
-- -   Classification: A patch classification. For example,
--     @security updates@.
--
-- -   PatchBaselineId: A patch baseline ID.
--
-- -   PatchSeverity: A patch severity. For example, @Critical@.
--
-- -   PatchState: A patch state. For example,
--     @InstancesWithFailedPatches@.
--
-- -   PatchGroup: The name of a patch group.
--
-- -   InstalledTime: The time the association, patch, or custom compliance
--     item was applied to the resource. Specify the time by using the
--     following format: yyyy-MM-dd\'T\'HH:mm:ss\'Z\'
module Amazonka.SSM.PutComplianceItems
  ( -- * Creating a Request
    PutComplianceItems (..),
    newPutComplianceItems,

    -- * Request Lenses
    putComplianceItems_itemContentHash,
    putComplianceItems_uploadType,
    putComplianceItems_resourceId,
    putComplianceItems_resourceType,
    putComplianceItems_complianceType,
    putComplianceItems_executionSummary,
    putComplianceItems_items,

    -- * Destructuring the Response
    PutComplianceItemsResponse (..),
    newPutComplianceItemsResponse,

    -- * Response Lenses
    putComplianceItemsResponse_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:/ 'newPutComplianceItems' smart constructor.
data PutComplianceItems = PutComplianceItems'
  { -- | MD5 or SHA-256 content hash. The content hash is used to determine if
    -- existing information should be overwritten or ignored. If the content
    -- hashes match, the request to put compliance information is ignored.
    PutComplianceItems -> Maybe Text
itemContentHash :: Prelude.Maybe Prelude.Text,
    -- | The mode for uploading compliance items. You can specify @COMPLETE@ or
    -- @PARTIAL@. In @COMPLETE@ mode, the system overwrites all existing
    -- compliance information for the resource. You must provide a full list of
    -- compliance items each time you send the request.
    --
    -- In @PARTIAL@ mode, the system overwrites compliance information for a
    -- specific association. The association must be configured with
    -- @SyncCompliance@ set to @MANUAL@. By default, all requests use
    -- @COMPLETE@ mode.
    --
    -- This attribute is only valid for association compliance.
    PutComplianceItems -> Maybe ComplianceUploadType
uploadType :: Prelude.Maybe ComplianceUploadType,
    -- | Specify an ID for this resource. For a managed node, this is the node
    -- ID.
    PutComplianceItems -> Text
resourceId :: Prelude.Text,
    -- | Specify the type of resource. @ManagedInstance@ is currently the only
    -- supported resource type.
    PutComplianceItems -> Text
resourceType :: Prelude.Text,
    -- | Specify the compliance type. For example, specify Association (for a
    -- State Manager association), Patch, or Custom:@string@.
    PutComplianceItems -> Text
complianceType :: Prelude.Text,
    -- | A summary of the call execution that includes an execution ID, the type
    -- of execution (for example, @Command@), and the date\/time of the
    -- execution using a datetime object that is saved in the following format:
    -- yyyy-MM-dd\'T\'HH:mm:ss\'Z\'.
    PutComplianceItems -> ComplianceExecutionSummary
executionSummary :: ComplianceExecutionSummary,
    -- | Information about the compliance as defined by the resource type. For
    -- example, for a patch compliance type, @Items@ includes information about
    -- the PatchSeverity, Classification, and so on.
    PutComplianceItems -> [ComplianceItemEntry]
items :: [ComplianceItemEntry]
  }
  deriving (PutComplianceItems -> PutComplianceItems -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutComplianceItems -> PutComplianceItems -> Bool
$c/= :: PutComplianceItems -> PutComplianceItems -> Bool
== :: PutComplianceItems -> PutComplianceItems -> Bool
$c== :: PutComplianceItems -> PutComplianceItems -> Bool
Prelude.Eq, ReadPrec [PutComplianceItems]
ReadPrec PutComplianceItems
Int -> ReadS PutComplianceItems
ReadS [PutComplianceItems]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutComplianceItems]
$creadListPrec :: ReadPrec [PutComplianceItems]
readPrec :: ReadPrec PutComplianceItems
$creadPrec :: ReadPrec PutComplianceItems
readList :: ReadS [PutComplianceItems]
$creadList :: ReadS [PutComplianceItems]
readsPrec :: Int -> ReadS PutComplianceItems
$creadsPrec :: Int -> ReadS PutComplianceItems
Prelude.Read, Int -> PutComplianceItems -> ShowS
[PutComplianceItems] -> ShowS
PutComplianceItems -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutComplianceItems] -> ShowS
$cshowList :: [PutComplianceItems] -> ShowS
show :: PutComplianceItems -> String
$cshow :: PutComplianceItems -> String
showsPrec :: Int -> PutComplianceItems -> ShowS
$cshowsPrec :: Int -> PutComplianceItems -> ShowS
Prelude.Show, forall x. Rep PutComplianceItems x -> PutComplianceItems
forall x. PutComplianceItems -> Rep PutComplianceItems x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutComplianceItems x -> PutComplianceItems
$cfrom :: forall x. PutComplianceItems -> Rep PutComplianceItems x
Prelude.Generic)

-- |
-- Create a value of 'PutComplianceItems' 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:
--
-- 'itemContentHash', 'putComplianceItems_itemContentHash' - MD5 or SHA-256 content hash. The content hash is used to determine if
-- existing information should be overwritten or ignored. If the content
-- hashes match, the request to put compliance information is ignored.
--
-- 'uploadType', 'putComplianceItems_uploadType' - The mode for uploading compliance items. You can specify @COMPLETE@ or
-- @PARTIAL@. In @COMPLETE@ mode, the system overwrites all existing
-- compliance information for the resource. You must provide a full list of
-- compliance items each time you send the request.
--
-- In @PARTIAL@ mode, the system overwrites compliance information for a
-- specific association. The association must be configured with
-- @SyncCompliance@ set to @MANUAL@. By default, all requests use
-- @COMPLETE@ mode.
--
-- This attribute is only valid for association compliance.
--
-- 'resourceId', 'putComplianceItems_resourceId' - Specify an ID for this resource. For a managed node, this is the node
-- ID.
--
-- 'resourceType', 'putComplianceItems_resourceType' - Specify the type of resource. @ManagedInstance@ is currently the only
-- supported resource type.
--
-- 'complianceType', 'putComplianceItems_complianceType' - Specify the compliance type. For example, specify Association (for a
-- State Manager association), Patch, or Custom:@string@.
--
-- 'executionSummary', 'putComplianceItems_executionSummary' - A summary of the call execution that includes an execution ID, the type
-- of execution (for example, @Command@), and the date\/time of the
-- execution using a datetime object that is saved in the following format:
-- yyyy-MM-dd\'T\'HH:mm:ss\'Z\'.
--
-- 'items', 'putComplianceItems_items' - Information about the compliance as defined by the resource type. For
-- example, for a patch compliance type, @Items@ includes information about
-- the PatchSeverity, Classification, and so on.
newPutComplianceItems ::
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'resourceType'
  Prelude.Text ->
  -- | 'complianceType'
  Prelude.Text ->
  -- | 'executionSummary'
  ComplianceExecutionSummary ->
  PutComplianceItems
newPutComplianceItems :: Text
-> Text -> Text -> ComplianceExecutionSummary -> PutComplianceItems
newPutComplianceItems
  Text
pResourceId_
  Text
pResourceType_
  Text
pComplianceType_
  ComplianceExecutionSummary
pExecutionSummary_ =
    PutComplianceItems'
      { $sel:itemContentHash:PutComplianceItems' :: Maybe Text
itemContentHash =
          forall a. Maybe a
Prelude.Nothing,
        $sel:uploadType:PutComplianceItems' :: Maybe ComplianceUploadType
uploadType = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceId:PutComplianceItems' :: Text
resourceId = Text
pResourceId_,
        $sel:resourceType:PutComplianceItems' :: Text
resourceType = Text
pResourceType_,
        $sel:complianceType:PutComplianceItems' :: Text
complianceType = Text
pComplianceType_,
        $sel:executionSummary:PutComplianceItems' :: ComplianceExecutionSummary
executionSummary = ComplianceExecutionSummary
pExecutionSummary_,
        $sel:items:PutComplianceItems' :: [ComplianceItemEntry]
items = forall a. Monoid a => a
Prelude.mempty
      }

-- | MD5 or SHA-256 content hash. The content hash is used to determine if
-- existing information should be overwritten or ignored. If the content
-- hashes match, the request to put compliance information is ignored.
putComplianceItems_itemContentHash :: Lens.Lens' PutComplianceItems (Prelude.Maybe Prelude.Text)
putComplianceItems_itemContentHash :: Lens' PutComplianceItems (Maybe Text)
putComplianceItems_itemContentHash = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {Maybe Text
itemContentHash :: Maybe Text
$sel:itemContentHash:PutComplianceItems' :: PutComplianceItems -> Maybe Text
itemContentHash} -> Maybe Text
itemContentHash) (\s :: PutComplianceItems
s@PutComplianceItems' {} Maybe Text
a -> PutComplianceItems
s {$sel:itemContentHash:PutComplianceItems' :: Maybe Text
itemContentHash = Maybe Text
a} :: PutComplianceItems)

-- | The mode for uploading compliance items. You can specify @COMPLETE@ or
-- @PARTIAL@. In @COMPLETE@ mode, the system overwrites all existing
-- compliance information for the resource. You must provide a full list of
-- compliance items each time you send the request.
--
-- In @PARTIAL@ mode, the system overwrites compliance information for a
-- specific association. The association must be configured with
-- @SyncCompliance@ set to @MANUAL@. By default, all requests use
-- @COMPLETE@ mode.
--
-- This attribute is only valid for association compliance.
putComplianceItems_uploadType :: Lens.Lens' PutComplianceItems (Prelude.Maybe ComplianceUploadType)
putComplianceItems_uploadType :: Lens' PutComplianceItems (Maybe ComplianceUploadType)
putComplianceItems_uploadType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {Maybe ComplianceUploadType
uploadType :: Maybe ComplianceUploadType
$sel:uploadType:PutComplianceItems' :: PutComplianceItems -> Maybe ComplianceUploadType
uploadType} -> Maybe ComplianceUploadType
uploadType) (\s :: PutComplianceItems
s@PutComplianceItems' {} Maybe ComplianceUploadType
a -> PutComplianceItems
s {$sel:uploadType:PutComplianceItems' :: Maybe ComplianceUploadType
uploadType = Maybe ComplianceUploadType
a} :: PutComplianceItems)

-- | Specify an ID for this resource. For a managed node, this is the node
-- ID.
putComplianceItems_resourceId :: Lens.Lens' PutComplianceItems Prelude.Text
putComplianceItems_resourceId :: Lens' PutComplianceItems Text
putComplianceItems_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {Text
resourceId :: Text
$sel:resourceId:PutComplianceItems' :: PutComplianceItems -> Text
resourceId} -> Text
resourceId) (\s :: PutComplianceItems
s@PutComplianceItems' {} Text
a -> PutComplianceItems
s {$sel:resourceId:PutComplianceItems' :: Text
resourceId = Text
a} :: PutComplianceItems)

-- | Specify the type of resource. @ManagedInstance@ is currently the only
-- supported resource type.
putComplianceItems_resourceType :: Lens.Lens' PutComplianceItems Prelude.Text
putComplianceItems_resourceType :: Lens' PutComplianceItems Text
putComplianceItems_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {Text
resourceType :: Text
$sel:resourceType:PutComplianceItems' :: PutComplianceItems -> Text
resourceType} -> Text
resourceType) (\s :: PutComplianceItems
s@PutComplianceItems' {} Text
a -> PutComplianceItems
s {$sel:resourceType:PutComplianceItems' :: Text
resourceType = Text
a} :: PutComplianceItems)

-- | Specify the compliance type. For example, specify Association (for a
-- State Manager association), Patch, or Custom:@string@.
putComplianceItems_complianceType :: Lens.Lens' PutComplianceItems Prelude.Text
putComplianceItems_complianceType :: Lens' PutComplianceItems Text
putComplianceItems_complianceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {Text
complianceType :: Text
$sel:complianceType:PutComplianceItems' :: PutComplianceItems -> Text
complianceType} -> Text
complianceType) (\s :: PutComplianceItems
s@PutComplianceItems' {} Text
a -> PutComplianceItems
s {$sel:complianceType:PutComplianceItems' :: Text
complianceType = Text
a} :: PutComplianceItems)

-- | A summary of the call execution that includes an execution ID, the type
-- of execution (for example, @Command@), and the date\/time of the
-- execution using a datetime object that is saved in the following format:
-- yyyy-MM-dd\'T\'HH:mm:ss\'Z\'.
putComplianceItems_executionSummary :: Lens.Lens' PutComplianceItems ComplianceExecutionSummary
putComplianceItems_executionSummary :: Lens' PutComplianceItems ComplianceExecutionSummary
putComplianceItems_executionSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {ComplianceExecutionSummary
executionSummary :: ComplianceExecutionSummary
$sel:executionSummary:PutComplianceItems' :: PutComplianceItems -> ComplianceExecutionSummary
executionSummary} -> ComplianceExecutionSummary
executionSummary) (\s :: PutComplianceItems
s@PutComplianceItems' {} ComplianceExecutionSummary
a -> PutComplianceItems
s {$sel:executionSummary:PutComplianceItems' :: ComplianceExecutionSummary
executionSummary = ComplianceExecutionSummary
a} :: PutComplianceItems)

-- | Information about the compliance as defined by the resource type. For
-- example, for a patch compliance type, @Items@ includes information about
-- the PatchSeverity, Classification, and so on.
putComplianceItems_items :: Lens.Lens' PutComplianceItems [ComplianceItemEntry]
putComplianceItems_items :: Lens' PutComplianceItems [ComplianceItemEntry]
putComplianceItems_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutComplianceItems' {[ComplianceItemEntry]
items :: [ComplianceItemEntry]
$sel:items:PutComplianceItems' :: PutComplianceItems -> [ComplianceItemEntry]
items} -> [ComplianceItemEntry]
items) (\s :: PutComplianceItems
s@PutComplianceItems' {} [ComplianceItemEntry]
a -> PutComplianceItems
s {$sel:items:PutComplianceItems' :: [ComplianceItemEntry]
items = [ComplianceItemEntry]
a} :: PutComplianceItems) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest PutComplianceItems where
  type
    AWSResponse PutComplianceItems =
      PutComplianceItemsResponse
  request :: (Service -> Service)
-> PutComplianceItems -> Request PutComplianceItems
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 PutComplianceItems
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutComplianceItems)))
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 -> PutComplianceItemsResponse
PutComplianceItemsResponse'
            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 PutComplianceItems where
  hashWithSalt :: Int -> PutComplianceItems -> Int
hashWithSalt Int
_salt PutComplianceItems' {[ComplianceItemEntry]
Maybe Text
Maybe ComplianceUploadType
Text
ComplianceExecutionSummary
items :: [ComplianceItemEntry]
executionSummary :: ComplianceExecutionSummary
complianceType :: Text
resourceType :: Text
resourceId :: Text
uploadType :: Maybe ComplianceUploadType
itemContentHash :: Maybe Text
$sel:items:PutComplianceItems' :: PutComplianceItems -> [ComplianceItemEntry]
$sel:executionSummary:PutComplianceItems' :: PutComplianceItems -> ComplianceExecutionSummary
$sel:complianceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceId:PutComplianceItems' :: PutComplianceItems -> Text
$sel:uploadType:PutComplianceItems' :: PutComplianceItems -> Maybe ComplianceUploadType
$sel:itemContentHash:PutComplianceItems' :: PutComplianceItems -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
itemContentHash
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComplianceUploadType
uploadType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
complianceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ComplianceExecutionSummary
executionSummary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ComplianceItemEntry]
items

instance Prelude.NFData PutComplianceItems where
  rnf :: PutComplianceItems -> ()
rnf PutComplianceItems' {[ComplianceItemEntry]
Maybe Text
Maybe ComplianceUploadType
Text
ComplianceExecutionSummary
items :: [ComplianceItemEntry]
executionSummary :: ComplianceExecutionSummary
complianceType :: Text
resourceType :: Text
resourceId :: Text
uploadType :: Maybe ComplianceUploadType
itemContentHash :: Maybe Text
$sel:items:PutComplianceItems' :: PutComplianceItems -> [ComplianceItemEntry]
$sel:executionSummary:PutComplianceItems' :: PutComplianceItems -> ComplianceExecutionSummary
$sel:complianceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceId:PutComplianceItems' :: PutComplianceItems -> Text
$sel:uploadType:PutComplianceItems' :: PutComplianceItems -> Maybe ComplianceUploadType
$sel:itemContentHash:PutComplianceItems' :: PutComplianceItems -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
itemContentHash
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComplianceUploadType
uploadType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
complianceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ComplianceExecutionSummary
executionSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ComplianceItemEntry]
items

instance Data.ToHeaders PutComplianceItems where
  toHeaders :: PutComplianceItems -> 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.PutComplianceItems" ::
                          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 PutComplianceItems where
  toJSON :: PutComplianceItems -> Value
toJSON PutComplianceItems' {[ComplianceItemEntry]
Maybe Text
Maybe ComplianceUploadType
Text
ComplianceExecutionSummary
items :: [ComplianceItemEntry]
executionSummary :: ComplianceExecutionSummary
complianceType :: Text
resourceType :: Text
resourceId :: Text
uploadType :: Maybe ComplianceUploadType
itemContentHash :: Maybe Text
$sel:items:PutComplianceItems' :: PutComplianceItems -> [ComplianceItemEntry]
$sel:executionSummary:PutComplianceItems' :: PutComplianceItems -> ComplianceExecutionSummary
$sel:complianceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceType:PutComplianceItems' :: PutComplianceItems -> Text
$sel:resourceId:PutComplianceItems' :: PutComplianceItems -> Text
$sel:uploadType:PutComplianceItems' :: PutComplianceItems -> Maybe ComplianceUploadType
$sel:itemContentHash:PutComplianceItems' :: PutComplianceItems -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ItemContentHash" 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
itemContentHash,
            (Key
"UploadType" 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 ComplianceUploadType
uploadType,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ComplianceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
complianceType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExecutionSummary" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ComplianceExecutionSummary
executionSummary),
            forall a. a -> Maybe a
Prelude.Just (Key
"Items" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ComplianceItemEntry]
items)
          ]
      )

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

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

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

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

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

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