{-# 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.CreatePatchBaseline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a patch baseline.
--
-- For information about valid key-value pairs in @PatchFilters@ for each
-- supported operating system type, see PatchFilter.
module Amazonka.SSM.CreatePatchBaseline
  ( -- * Creating a Request
    CreatePatchBaseline (..),
    newCreatePatchBaseline,

    -- * Request Lenses
    createPatchBaseline_approvalRules,
    createPatchBaseline_approvedPatches,
    createPatchBaseline_approvedPatchesComplianceLevel,
    createPatchBaseline_approvedPatchesEnableNonSecurity,
    createPatchBaseline_clientToken,
    createPatchBaseline_description,
    createPatchBaseline_globalFilters,
    createPatchBaseline_operatingSystem,
    createPatchBaseline_rejectedPatches,
    createPatchBaseline_rejectedPatchesAction,
    createPatchBaseline_sources,
    createPatchBaseline_tags,
    createPatchBaseline_name,

    -- * Destructuring the Response
    CreatePatchBaselineResponse (..),
    newCreatePatchBaselineResponse,

    -- * Response Lenses
    createPatchBaselineResponse_baselineId,
    createPatchBaselineResponse_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:/ 'newCreatePatchBaseline' smart constructor.
data CreatePatchBaseline = CreatePatchBaseline'
  { -- | A set of rules used to include patches in the baseline.
    CreatePatchBaseline -> Maybe PatchRuleGroup
approvalRules :: Prelude.Maybe PatchRuleGroup,
    -- | A list of explicitly approved patches for the baseline.
    --
    -- For information about accepted formats for lists of approved patches and
    -- rejected patches, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    CreatePatchBaseline -> Maybe [Text]
approvedPatches :: Prelude.Maybe [Prelude.Text],
    -- | Defines the compliance level for approved patches. When an approved
    -- patch is reported as missing, this value describes the severity of the
    -- compliance violation. The default value is @UNSPECIFIED@.
    CreatePatchBaseline -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel :: Prelude.Maybe PatchComplianceLevel,
    -- | Indicates whether the list of approved patches includes non-security
    -- updates that should be applied to the managed nodes. The default value
    -- is @false@. Applies to Linux managed nodes only.
    CreatePatchBaseline -> Maybe Bool
approvedPatchesEnableNonSecurity :: Prelude.Maybe Prelude.Bool,
    -- | User-provided idempotency token.
    CreatePatchBaseline -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the patch baseline.
    CreatePatchBaseline -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A set of global filters used to include patches in the baseline.
    CreatePatchBaseline -> Maybe PatchFilterGroup
globalFilters :: Prelude.Maybe PatchFilterGroup,
    -- | Defines the operating system the patch baseline applies to. The default
    -- value is @WINDOWS@.
    CreatePatchBaseline -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | A list of explicitly rejected patches for the baseline.
    --
    -- For information about accepted formats for lists of approved patches and
    -- rejected patches, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    CreatePatchBaseline -> Maybe [Text]
rejectedPatches :: Prelude.Maybe [Prelude.Text],
    -- | The action for Patch Manager to take on patches included in the
    -- @RejectedPackages@ list.
    --
    -- -   __@ALLOW_AS_DEPENDENCY@__ : A package in the @Rejected@ patches list
    --     is installed only if it is a dependency of another package. It is
    --     considered compliant with the patch baseline, and its status is
    --     reported as @InstalledOther@. This is the default action if no
    --     option is specified.
    --
    -- -   __@BLOCK@__ : Packages in the @RejectedPatches@ list, and packages
    --     that include them as dependencies, aren\'t installed under any
    --     circumstances. If a package was installed before it was added to the
    --     Rejected patches list, it is considered non-compliant with the patch
    --     baseline, and its status is reported as @InstalledRejected@.
    CreatePatchBaseline -> Maybe PatchAction
rejectedPatchesAction :: Prelude.Maybe PatchAction,
    -- | Information about the patches to use to update the managed nodes,
    -- including target operating systems and source repositories. Applies to
    -- Linux managed nodes only.
    CreatePatchBaseline -> Maybe [PatchSource]
sources :: Prelude.Maybe [PatchSource],
    -- | Optional metadata that you assign to a resource. Tags enable you to
    -- categorize a resource in different ways, such as by purpose, owner, or
    -- environment. For example, you might want to tag a patch baseline to
    -- identify the severity level of patches it specifies and the operating
    -- system family it applies to. In this case, you could specify the
    -- following key-value pairs:
    --
    -- -   @Key=PatchSeverity,Value=Critical@
    --
    -- -   @Key=OS,Value=Windows@
    --
    -- To add tags to an existing patch baseline, use the AddTagsToResource
    -- operation.
    CreatePatchBaseline -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the patch baseline.
    CreatePatchBaseline -> Text
name :: Prelude.Text
  }
  deriving (CreatePatchBaseline -> CreatePatchBaseline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePatchBaseline -> CreatePatchBaseline -> Bool
$c/= :: CreatePatchBaseline -> CreatePatchBaseline -> Bool
== :: CreatePatchBaseline -> CreatePatchBaseline -> Bool
$c== :: CreatePatchBaseline -> CreatePatchBaseline -> Bool
Prelude.Eq, Int -> CreatePatchBaseline -> ShowS
[CreatePatchBaseline] -> ShowS
CreatePatchBaseline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePatchBaseline] -> ShowS
$cshowList :: [CreatePatchBaseline] -> ShowS
show :: CreatePatchBaseline -> String
$cshow :: CreatePatchBaseline -> String
showsPrec :: Int -> CreatePatchBaseline -> ShowS
$cshowsPrec :: Int -> CreatePatchBaseline -> ShowS
Prelude.Show, forall x. Rep CreatePatchBaseline x -> CreatePatchBaseline
forall x. CreatePatchBaseline -> Rep CreatePatchBaseline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePatchBaseline x -> CreatePatchBaseline
$cfrom :: forall x. CreatePatchBaseline -> Rep CreatePatchBaseline x
Prelude.Generic)

-- |
-- Create a value of 'CreatePatchBaseline' 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:
--
-- 'approvalRules', 'createPatchBaseline_approvalRules' - A set of rules used to include patches in the baseline.
--
-- 'approvedPatches', 'createPatchBaseline_approvedPatches' - A list of explicitly approved patches for the baseline.
--
-- For information about accepted formats for lists of approved patches and
-- rejected patches, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'approvedPatchesComplianceLevel', 'createPatchBaseline_approvedPatchesComplianceLevel' - Defines the compliance level for approved patches. When an approved
-- patch is reported as missing, this value describes the severity of the
-- compliance violation. The default value is @UNSPECIFIED@.
--
-- 'approvedPatchesEnableNonSecurity', 'createPatchBaseline_approvedPatchesEnableNonSecurity' - Indicates whether the list of approved patches includes non-security
-- updates that should be applied to the managed nodes. The default value
-- is @false@. Applies to Linux managed nodes only.
--
-- 'clientToken', 'createPatchBaseline_clientToken' - User-provided idempotency token.
--
-- 'description', 'createPatchBaseline_description' - A description of the patch baseline.
--
-- 'globalFilters', 'createPatchBaseline_globalFilters' - A set of global filters used to include patches in the baseline.
--
-- 'operatingSystem', 'createPatchBaseline_operatingSystem' - Defines the operating system the patch baseline applies to. The default
-- value is @WINDOWS@.
--
-- 'rejectedPatches', 'createPatchBaseline_rejectedPatches' - A list of explicitly rejected patches for the baseline.
--
-- For information about accepted formats for lists of approved patches and
-- rejected patches, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'rejectedPatchesAction', 'createPatchBaseline_rejectedPatchesAction' - The action for Patch Manager to take on patches included in the
-- @RejectedPackages@ list.
--
-- -   __@ALLOW_AS_DEPENDENCY@__ : A package in the @Rejected@ patches list
--     is installed only if it is a dependency of another package. It is
--     considered compliant with the patch baseline, and its status is
--     reported as @InstalledOther@. This is the default action if no
--     option is specified.
--
-- -   __@BLOCK@__ : Packages in the @RejectedPatches@ list, and packages
--     that include them as dependencies, aren\'t installed under any
--     circumstances. If a package was installed before it was added to the
--     Rejected patches list, it is considered non-compliant with the patch
--     baseline, and its status is reported as @InstalledRejected@.
--
-- 'sources', 'createPatchBaseline_sources' - Information about the patches to use to update the managed nodes,
-- including target operating systems and source repositories. Applies to
-- Linux managed nodes only.
--
-- 'tags', 'createPatchBaseline_tags' - Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag a patch baseline to
-- identify the severity level of patches it specifies and the operating
-- system family it applies to. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=PatchSeverity,Value=Critical@
--
-- -   @Key=OS,Value=Windows@
--
-- To add tags to an existing patch baseline, use the AddTagsToResource
-- operation.
--
-- 'name', 'createPatchBaseline_name' - The name of the patch baseline.
newCreatePatchBaseline ::
  -- | 'name'
  Prelude.Text ->
  CreatePatchBaseline
newCreatePatchBaseline :: Text -> CreatePatchBaseline
newCreatePatchBaseline Text
pName_ =
  CreatePatchBaseline'
    { $sel:approvalRules:CreatePatchBaseline' :: Maybe PatchRuleGroup
approvalRules =
        forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatches:CreatePatchBaseline' :: Maybe [Text]
approvedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: Maybe Bool
approvedPatchesEnableNonSecurity = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreatePatchBaseline' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreatePatchBaseline' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:globalFilters:CreatePatchBaseline' :: Maybe PatchFilterGroup
globalFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:CreatePatchBaseline' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatches:CreatePatchBaseline' :: Maybe [Text]
rejectedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatchesAction:CreatePatchBaseline' :: Maybe PatchAction
rejectedPatchesAction = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:CreatePatchBaseline' :: Maybe [PatchSource]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreatePatchBaseline' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreatePatchBaseline' :: Text
name = Text
pName_
    }

-- | A set of rules used to include patches in the baseline.
createPatchBaseline_approvalRules :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe PatchRuleGroup)
createPatchBaseline_approvalRules :: Lens' CreatePatchBaseline (Maybe PatchRuleGroup)
createPatchBaseline_approvalRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe PatchRuleGroup
approvalRules :: Maybe PatchRuleGroup
$sel:approvalRules:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchRuleGroup
approvalRules} -> Maybe PatchRuleGroup
approvalRules) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe PatchRuleGroup
a -> CreatePatchBaseline
s {$sel:approvalRules:CreatePatchBaseline' :: Maybe PatchRuleGroup
approvalRules = Maybe PatchRuleGroup
a} :: CreatePatchBaseline)

-- | A list of explicitly approved patches for the baseline.
--
-- For information about accepted formats for lists of approved patches and
-- rejected patches, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
-- in the /Amazon Web Services Systems Manager User Guide/.
createPatchBaseline_approvedPatches :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe [Prelude.Text])
createPatchBaseline_approvedPatches :: Lens' CreatePatchBaseline (Maybe [Text])
createPatchBaseline_approvedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe [Text]
approvedPatches :: Maybe [Text]
$sel:approvedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
approvedPatches} -> Maybe [Text]
approvedPatches) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe [Text]
a -> CreatePatchBaseline
s {$sel:approvedPatches:CreatePatchBaseline' :: Maybe [Text]
approvedPatches = Maybe [Text]
a} :: CreatePatchBaseline) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Defines the compliance level for approved patches. When an approved
-- patch is reported as missing, this value describes the severity of the
-- compliance violation. The default value is @UNSPECIFIED@.
createPatchBaseline_approvedPatchesComplianceLevel :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe PatchComplianceLevel)
createPatchBaseline_approvedPatchesComplianceLevel :: Lens' CreatePatchBaseline (Maybe PatchComplianceLevel)
createPatchBaseline_approvedPatchesComplianceLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe PatchComplianceLevel
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
$sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel} -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe PatchComplianceLevel
a -> CreatePatchBaseline
s {$sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel = Maybe PatchComplianceLevel
a} :: CreatePatchBaseline)

-- | Indicates whether the list of approved patches includes non-security
-- updates that should be applied to the managed nodes. The default value
-- is @false@. Applies to Linux managed nodes only.
createPatchBaseline_approvedPatchesEnableNonSecurity :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe Prelude.Bool)
createPatchBaseline_approvedPatchesEnableNonSecurity :: Lens' CreatePatchBaseline (Maybe Bool)
createPatchBaseline_approvedPatchesEnableNonSecurity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe Bool
approvedPatchesEnableNonSecurity :: Maybe Bool
$sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Bool
approvedPatchesEnableNonSecurity} -> Maybe Bool
approvedPatchesEnableNonSecurity) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe Bool
a -> CreatePatchBaseline
s {$sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: Maybe Bool
approvedPatchesEnableNonSecurity = Maybe Bool
a} :: CreatePatchBaseline)

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

-- | A description of the patch baseline.
createPatchBaseline_description :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe Prelude.Text)
createPatchBaseline_description :: Lens' CreatePatchBaseline (Maybe Text)
createPatchBaseline_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe Text
description :: Maybe Text
$sel:description:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
description} -> Maybe Text
description) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe Text
a -> CreatePatchBaseline
s {$sel:description:CreatePatchBaseline' :: Maybe Text
description = Maybe Text
a} :: CreatePatchBaseline)

-- | A set of global filters used to include patches in the baseline.
createPatchBaseline_globalFilters :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe PatchFilterGroup)
createPatchBaseline_globalFilters :: Lens' CreatePatchBaseline (Maybe PatchFilterGroup)
createPatchBaseline_globalFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe PatchFilterGroup
globalFilters :: Maybe PatchFilterGroup
$sel:globalFilters:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchFilterGroup
globalFilters} -> Maybe PatchFilterGroup
globalFilters) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe PatchFilterGroup
a -> CreatePatchBaseline
s {$sel:globalFilters:CreatePatchBaseline' :: Maybe PatchFilterGroup
globalFilters = Maybe PatchFilterGroup
a} :: CreatePatchBaseline)

-- | Defines the operating system the patch baseline applies to. The default
-- value is @WINDOWS@.
createPatchBaseline_operatingSystem :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe OperatingSystem)
createPatchBaseline_operatingSystem :: Lens' CreatePatchBaseline (Maybe OperatingSystem)
createPatchBaseline_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe OperatingSystem
a -> CreatePatchBaseline
s {$sel:operatingSystem:CreatePatchBaseline' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: CreatePatchBaseline)

-- | A list of explicitly rejected patches for the baseline.
--
-- For information about accepted formats for lists of approved patches and
-- rejected patches, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/patch-manager-approved-rejected-package-name-formats.html About package name formats for approved and rejected patch lists>
-- in the /Amazon Web Services Systems Manager User Guide/.
createPatchBaseline_rejectedPatches :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe [Prelude.Text])
createPatchBaseline_rejectedPatches :: Lens' CreatePatchBaseline (Maybe [Text])
createPatchBaseline_rejectedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe [Text]
rejectedPatches :: Maybe [Text]
$sel:rejectedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
rejectedPatches} -> Maybe [Text]
rejectedPatches) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe [Text]
a -> CreatePatchBaseline
s {$sel:rejectedPatches:CreatePatchBaseline' :: Maybe [Text]
rejectedPatches = Maybe [Text]
a} :: CreatePatchBaseline) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The action for Patch Manager to take on patches included in the
-- @RejectedPackages@ list.
--
-- -   __@ALLOW_AS_DEPENDENCY@__ : A package in the @Rejected@ patches list
--     is installed only if it is a dependency of another package. It is
--     considered compliant with the patch baseline, and its status is
--     reported as @InstalledOther@. This is the default action if no
--     option is specified.
--
-- -   __@BLOCK@__ : Packages in the @RejectedPatches@ list, and packages
--     that include them as dependencies, aren\'t installed under any
--     circumstances. If a package was installed before it was added to the
--     Rejected patches list, it is considered non-compliant with the patch
--     baseline, and its status is reported as @InstalledRejected@.
createPatchBaseline_rejectedPatchesAction :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe PatchAction)
createPatchBaseline_rejectedPatchesAction :: Lens' CreatePatchBaseline (Maybe PatchAction)
createPatchBaseline_rejectedPatchesAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe PatchAction
rejectedPatchesAction :: Maybe PatchAction
$sel:rejectedPatchesAction:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchAction
rejectedPatchesAction} -> Maybe PatchAction
rejectedPatchesAction) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe PatchAction
a -> CreatePatchBaseline
s {$sel:rejectedPatchesAction:CreatePatchBaseline' :: Maybe PatchAction
rejectedPatchesAction = Maybe PatchAction
a} :: CreatePatchBaseline)

-- | Information about the patches to use to update the managed nodes,
-- including target operating systems and source repositories. Applies to
-- Linux managed nodes only.
createPatchBaseline_sources :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe [PatchSource])
createPatchBaseline_sources :: Lens' CreatePatchBaseline (Maybe [PatchSource])
createPatchBaseline_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe [PatchSource]
sources :: Maybe [PatchSource]
$sel:sources:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [PatchSource]
sources} -> Maybe [PatchSource]
sources) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe [PatchSource]
a -> CreatePatchBaseline
s {$sel:sources:CreatePatchBaseline' :: Maybe [PatchSource]
sources = Maybe [PatchSource]
a} :: CreatePatchBaseline) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag a patch baseline to
-- identify the severity level of patches it specifies and the operating
-- system family it applies to. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=PatchSeverity,Value=Critical@
--
-- -   @Key=OS,Value=Windows@
--
-- To add tags to an existing patch baseline, use the AddTagsToResource
-- operation.
createPatchBaseline_tags :: Lens.Lens' CreatePatchBaseline (Prelude.Maybe [Tag])
createPatchBaseline_tags :: Lens' CreatePatchBaseline (Maybe [Tag])
createPatchBaseline_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Maybe [Tag]
a -> CreatePatchBaseline
s {$sel:tags:CreatePatchBaseline' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreatePatchBaseline) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the patch baseline.
createPatchBaseline_name :: Lens.Lens' CreatePatchBaseline Prelude.Text
createPatchBaseline_name :: Lens' CreatePatchBaseline Text
createPatchBaseline_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaseline' {Text
name :: Text
$sel:name:CreatePatchBaseline' :: CreatePatchBaseline -> Text
name} -> Text
name) (\s :: CreatePatchBaseline
s@CreatePatchBaseline' {} Text
a -> CreatePatchBaseline
s {$sel:name:CreatePatchBaseline' :: Text
name = Text
a} :: CreatePatchBaseline)

instance Core.AWSRequest CreatePatchBaseline where
  type
    AWSResponse CreatePatchBaseline =
      CreatePatchBaselineResponse
  request :: (Service -> Service)
-> CreatePatchBaseline -> Request CreatePatchBaseline
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 CreatePatchBaseline
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePatchBaseline)))
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 -> Int -> CreatePatchBaselineResponse
CreatePatchBaselineResponse'
            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
"BaselineId")
            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 CreatePatchBaseline where
  hashWithSalt :: Int -> CreatePatchBaseline -> Int
hashWithSalt Int
_salt CreatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
name :: Text
tags :: Maybe [Tag]
sources :: Maybe [PatchSource]
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
operatingSystem :: Maybe OperatingSystem
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
clientToken :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:name:CreatePatchBaseline' :: CreatePatchBaseline -> Text
$sel:tags:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Tag]
$sel:sources:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [PatchSource]
$sel:rejectedPatchesAction:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:operatingSystem:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe OperatingSystem
$sel:globalFilters:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:clientToken:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:approvalRules:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchRuleGroup
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PatchRuleGroup
approvalRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
approvedPatches
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PatchComplianceLevel
approvedPatchesComplianceLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
approvedPatchesEnableNonSecurity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PatchFilterGroup
globalFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperatingSystem
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
rejectedPatches
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PatchAction
rejectedPatchesAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PatchSource]
sources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreatePatchBaseline where
  rnf :: CreatePatchBaseline -> ()
rnf CreatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
name :: Text
tags :: Maybe [Tag]
sources :: Maybe [PatchSource]
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
operatingSystem :: Maybe OperatingSystem
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
clientToken :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:name:CreatePatchBaseline' :: CreatePatchBaseline -> Text
$sel:tags:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Tag]
$sel:sources:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [PatchSource]
$sel:rejectedPatchesAction:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:operatingSystem:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe OperatingSystem
$sel:globalFilters:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:clientToken:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:approvalRules:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchRuleGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PatchRuleGroup
approvalRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
approvedPatches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PatchComplianceLevel
approvedPatchesComplianceLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
approvedPatchesEnableNonSecurity
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PatchFilterGroup
globalFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperatingSystem
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
rejectedPatches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PatchAction
rejectedPatchesAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PatchSource]
sources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreatePatchBaseline where
  toHeaders :: CreatePatchBaseline -> 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.CreatePatchBaseline" ::
                          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 CreatePatchBaseline where
  toJSON :: CreatePatchBaseline -> Value
toJSON CreatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
name :: Text
tags :: Maybe [Tag]
sources :: Maybe [PatchSource]
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
operatingSystem :: Maybe OperatingSystem
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
clientToken :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:name:CreatePatchBaseline' :: CreatePatchBaseline -> Text
$sel:tags:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Tag]
$sel:sources:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [PatchSource]
$sel:rejectedPatchesAction:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:operatingSystem:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe OperatingSystem
$sel:globalFilters:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:clientToken:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe [Text]
$sel:approvalRules:CreatePatchBaseline' :: CreatePatchBaseline -> Maybe PatchRuleGroup
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApprovalRules" 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 PatchRuleGroup
approvalRules,
            (Key
"ApprovedPatches" 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]
approvedPatches,
            (Key
"ApprovedPatchesComplianceLevel" 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 PatchComplianceLevel
approvedPatchesComplianceLevel,
            (Key
"ApprovedPatchesEnableNonSecurity" 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
approvedPatchesEnableNonSecurity,
            (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
"Description" 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
description,
            (Key
"GlobalFilters" 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 PatchFilterGroup
globalFilters,
            (Key
"OperatingSystem" 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 OperatingSystem
operatingSystem,
            (Key
"RejectedPatches" 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]
rejectedPatches,
            (Key
"RejectedPatchesAction" 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 PatchAction
rejectedPatchesAction,
            (Key
"Sources" 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 [PatchSource]
sources,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreatePatchBaselineResponse' 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:
--
-- 'baselineId', 'createPatchBaselineResponse_baselineId' - The ID of the created patch baseline.
--
-- 'httpStatus', 'createPatchBaselineResponse_httpStatus' - The response's http status code.
newCreatePatchBaselineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePatchBaselineResponse
newCreatePatchBaselineResponse :: Int -> CreatePatchBaselineResponse
newCreatePatchBaselineResponse Int
pHttpStatus_ =
  CreatePatchBaselineResponse'
    { $sel:baselineId:CreatePatchBaselineResponse' :: Maybe Text
baselineId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePatchBaselineResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the created patch baseline.
createPatchBaselineResponse_baselineId :: Lens.Lens' CreatePatchBaselineResponse (Prelude.Maybe Prelude.Text)
createPatchBaselineResponse_baselineId :: Lens' CreatePatchBaselineResponse (Maybe Text)
createPatchBaselineResponse_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePatchBaselineResponse' {Maybe Text
baselineId :: Maybe Text
$sel:baselineId:CreatePatchBaselineResponse' :: CreatePatchBaselineResponse -> Maybe Text
baselineId} -> Maybe Text
baselineId) (\s :: CreatePatchBaselineResponse
s@CreatePatchBaselineResponse' {} Maybe Text
a -> CreatePatchBaselineResponse
s {$sel:baselineId:CreatePatchBaselineResponse' :: Maybe Text
baselineId = Maybe Text
a} :: CreatePatchBaselineResponse)

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

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