{-# 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.UpdatePatchBaseline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies an existing patch baseline. Fields not specified in the request
-- are left unchanged.
--
-- For information about valid key-value pairs in @PatchFilters@ for each
-- supported operating system type, see PatchFilter.
module Amazonka.SSM.UpdatePatchBaseline
  ( -- * Creating a Request
    UpdatePatchBaseline (..),
    newUpdatePatchBaseline,

    -- * Request Lenses
    updatePatchBaseline_approvalRules,
    updatePatchBaseline_approvedPatches,
    updatePatchBaseline_approvedPatchesComplianceLevel,
    updatePatchBaseline_approvedPatchesEnableNonSecurity,
    updatePatchBaseline_description,
    updatePatchBaseline_globalFilters,
    updatePatchBaseline_name,
    updatePatchBaseline_rejectedPatches,
    updatePatchBaseline_rejectedPatchesAction,
    updatePatchBaseline_replace,
    updatePatchBaseline_sources,
    updatePatchBaseline_baselineId,

    -- * Destructuring the Response
    UpdatePatchBaselineResponse (..),
    newUpdatePatchBaselineResponse,

    -- * Response Lenses
    updatePatchBaselineResponse_approvalRules,
    updatePatchBaselineResponse_approvedPatches,
    updatePatchBaselineResponse_approvedPatchesComplianceLevel,
    updatePatchBaselineResponse_approvedPatchesEnableNonSecurity,
    updatePatchBaselineResponse_baselineId,
    updatePatchBaselineResponse_createdDate,
    updatePatchBaselineResponse_description,
    updatePatchBaselineResponse_globalFilters,
    updatePatchBaselineResponse_modifiedDate,
    updatePatchBaselineResponse_name,
    updatePatchBaselineResponse_operatingSystem,
    updatePatchBaselineResponse_rejectedPatches,
    updatePatchBaselineResponse_rejectedPatchesAction,
    updatePatchBaselineResponse_sources,
    updatePatchBaselineResponse_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:/ 'newUpdatePatchBaseline' smart constructor.
data UpdatePatchBaseline = UpdatePatchBaseline'
  { -- | A set of rules used to include patches in the baseline.
    UpdatePatchBaseline -> 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/.
    UpdatePatchBaseline -> Maybe [Text]
approvedPatches :: Prelude.Maybe [Prelude.Text],
    -- | Assigns a new compliance severity level to an existing patch baseline.
    UpdatePatchBaseline -> 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.
    UpdatePatchBaseline -> Maybe Bool
approvedPatchesEnableNonSecurity :: Prelude.Maybe Prelude.Bool,
    -- | A description of the patch baseline.
    UpdatePatchBaseline -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A set of global filters used to include patches in the baseline.
    UpdatePatchBaseline -> Maybe PatchFilterGroup
globalFilters :: Prelude.Maybe PatchFilterGroup,
    -- | The name of the patch baseline.
    UpdatePatchBaseline -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | 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/.
    UpdatePatchBaseline -> 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@.
    UpdatePatchBaseline -> Maybe PatchAction
rejectedPatchesAction :: Prelude.Maybe PatchAction,
    -- | If True, then all fields that are required by the CreatePatchBaseline
    -- operation are also required for this API request. Optional fields that
    -- aren\'t specified are set to null.
    UpdatePatchBaseline -> Maybe Bool
replace :: Prelude.Maybe Prelude.Bool,
    -- | Information about the patches to use to update the managed nodes,
    -- including target operating systems and source repositories. Applies to
    -- Linux managed nodes only.
    UpdatePatchBaseline -> Maybe [PatchSource]
sources :: Prelude.Maybe [PatchSource],
    -- | The ID of the patch baseline to update.
    UpdatePatchBaseline -> Text
baselineId :: Prelude.Text
  }
  deriving (UpdatePatchBaseline -> UpdatePatchBaseline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePatchBaseline -> UpdatePatchBaseline -> Bool
$c/= :: UpdatePatchBaseline -> UpdatePatchBaseline -> Bool
== :: UpdatePatchBaseline -> UpdatePatchBaseline -> Bool
$c== :: UpdatePatchBaseline -> UpdatePatchBaseline -> Bool
Prelude.Eq, Int -> UpdatePatchBaseline -> ShowS
[UpdatePatchBaseline] -> ShowS
UpdatePatchBaseline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePatchBaseline] -> ShowS
$cshowList :: [UpdatePatchBaseline] -> ShowS
show :: UpdatePatchBaseline -> String
$cshow :: UpdatePatchBaseline -> String
showsPrec :: Int -> UpdatePatchBaseline -> ShowS
$cshowsPrec :: Int -> UpdatePatchBaseline -> ShowS
Prelude.Show, forall x. Rep UpdatePatchBaseline x -> UpdatePatchBaseline
forall x. UpdatePatchBaseline -> Rep UpdatePatchBaseline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePatchBaseline x -> UpdatePatchBaseline
$cfrom :: forall x. UpdatePatchBaseline -> Rep UpdatePatchBaseline x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePatchBaseline' 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', 'updatePatchBaseline_approvalRules' - A set of rules used to include patches in the baseline.
--
-- 'approvedPatches', 'updatePatchBaseline_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', 'updatePatchBaseline_approvedPatchesComplianceLevel' - Assigns a new compliance severity level to an existing patch baseline.
--
-- 'approvedPatchesEnableNonSecurity', 'updatePatchBaseline_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.
--
-- 'description', 'updatePatchBaseline_description' - A description of the patch baseline.
--
-- 'globalFilters', 'updatePatchBaseline_globalFilters' - A set of global filters used to include patches in the baseline.
--
-- 'name', 'updatePatchBaseline_name' - The name of the patch baseline.
--
-- 'rejectedPatches', 'updatePatchBaseline_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', 'updatePatchBaseline_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@.
--
-- 'replace', 'updatePatchBaseline_replace' - If True, then all fields that are required by the CreatePatchBaseline
-- operation are also required for this API request. Optional fields that
-- aren\'t specified are set to null.
--
-- 'sources', 'updatePatchBaseline_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.
--
-- 'baselineId', 'updatePatchBaseline_baselineId' - The ID of the patch baseline to update.
newUpdatePatchBaseline ::
  -- | 'baselineId'
  Prelude.Text ->
  UpdatePatchBaseline
newUpdatePatchBaseline :: Text -> UpdatePatchBaseline
newUpdatePatchBaseline Text
pBaselineId_ =
  UpdatePatchBaseline'
    { $sel:approvalRules:UpdatePatchBaseline' :: Maybe PatchRuleGroup
approvalRules =
        forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatches:UpdatePatchBaseline' :: Maybe [Text]
approvedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: Maybe Bool
approvedPatchesEnableNonSecurity = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdatePatchBaseline' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:globalFilters:UpdatePatchBaseline' :: Maybe PatchFilterGroup
globalFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdatePatchBaseline' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatches:UpdatePatchBaseline' :: Maybe [Text]
rejectedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatchesAction:UpdatePatchBaseline' :: Maybe PatchAction
rejectedPatchesAction = forall a. Maybe a
Prelude.Nothing,
      $sel:replace:UpdatePatchBaseline' :: Maybe Bool
replace = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:UpdatePatchBaseline' :: Maybe [PatchSource]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:baselineId:UpdatePatchBaseline' :: Text
baselineId = Text
pBaselineId_
    }

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

-- | 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/.
updatePatchBaseline_approvedPatches :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe [Prelude.Text])
updatePatchBaseline_approvedPatches :: Lens' UpdatePatchBaseline (Maybe [Text])
updatePatchBaseline_approvedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe [Text]
approvedPatches :: Maybe [Text]
$sel:approvedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
approvedPatches} -> Maybe [Text]
approvedPatches) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe [Text]
a -> UpdatePatchBaseline
s {$sel:approvedPatches:UpdatePatchBaseline' :: Maybe [Text]
approvedPatches = Maybe [Text]
a} :: UpdatePatchBaseline) 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

-- | Assigns a new compliance severity level to an existing patch baseline.
updatePatchBaseline_approvedPatchesComplianceLevel :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe PatchComplianceLevel)
updatePatchBaseline_approvedPatchesComplianceLevel :: Lens' UpdatePatchBaseline (Maybe PatchComplianceLevel)
updatePatchBaseline_approvedPatchesComplianceLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe PatchComplianceLevel
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
$sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel} -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe PatchComplianceLevel
a -> UpdatePatchBaseline
s {$sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel = Maybe PatchComplianceLevel
a} :: UpdatePatchBaseline)

-- | 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.
updatePatchBaseline_approvedPatchesEnableNonSecurity :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe Prelude.Bool)
updatePatchBaseline_approvedPatchesEnableNonSecurity :: Lens' UpdatePatchBaseline (Maybe Bool)
updatePatchBaseline_approvedPatchesEnableNonSecurity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe Bool
approvedPatchesEnableNonSecurity :: Maybe Bool
$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
approvedPatchesEnableNonSecurity} -> Maybe Bool
approvedPatchesEnableNonSecurity) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe Bool
a -> UpdatePatchBaseline
s {$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: Maybe Bool
approvedPatchesEnableNonSecurity = Maybe Bool
a} :: UpdatePatchBaseline)

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

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

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

-- | 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/.
updatePatchBaseline_rejectedPatches :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe [Prelude.Text])
updatePatchBaseline_rejectedPatches :: Lens' UpdatePatchBaseline (Maybe [Text])
updatePatchBaseline_rejectedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe [Text]
rejectedPatches :: Maybe [Text]
$sel:rejectedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
rejectedPatches} -> Maybe [Text]
rejectedPatches) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe [Text]
a -> UpdatePatchBaseline
s {$sel:rejectedPatches:UpdatePatchBaseline' :: Maybe [Text]
rejectedPatches = Maybe [Text]
a} :: UpdatePatchBaseline) 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@.
updatePatchBaseline_rejectedPatchesAction :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe PatchAction)
updatePatchBaseline_rejectedPatchesAction :: Lens' UpdatePatchBaseline (Maybe PatchAction)
updatePatchBaseline_rejectedPatchesAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe PatchAction
rejectedPatchesAction :: Maybe PatchAction
$sel:rejectedPatchesAction:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchAction
rejectedPatchesAction} -> Maybe PatchAction
rejectedPatchesAction) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe PatchAction
a -> UpdatePatchBaseline
s {$sel:rejectedPatchesAction:UpdatePatchBaseline' :: Maybe PatchAction
rejectedPatchesAction = Maybe PatchAction
a} :: UpdatePatchBaseline)

-- | If True, then all fields that are required by the CreatePatchBaseline
-- operation are also required for this API request. Optional fields that
-- aren\'t specified are set to null.
updatePatchBaseline_replace :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe Prelude.Bool)
updatePatchBaseline_replace :: Lens' UpdatePatchBaseline (Maybe Bool)
updatePatchBaseline_replace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe Bool
replace :: Maybe Bool
$sel:replace:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
replace} -> Maybe Bool
replace) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe Bool
a -> UpdatePatchBaseline
s {$sel:replace:UpdatePatchBaseline' :: Maybe Bool
replace = Maybe Bool
a} :: UpdatePatchBaseline)

-- | Information about the patches to use to update the managed nodes,
-- including target operating systems and source repositories. Applies to
-- Linux managed nodes only.
updatePatchBaseline_sources :: Lens.Lens' UpdatePatchBaseline (Prelude.Maybe [PatchSource])
updatePatchBaseline_sources :: Lens' UpdatePatchBaseline (Maybe [PatchSource])
updatePatchBaseline_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Maybe [PatchSource]
sources :: Maybe [PatchSource]
$sel:sources:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [PatchSource]
sources} -> Maybe [PatchSource]
sources) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Maybe [PatchSource]
a -> UpdatePatchBaseline
s {$sel:sources:UpdatePatchBaseline' :: Maybe [PatchSource]
sources = Maybe [PatchSource]
a} :: UpdatePatchBaseline) 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 ID of the patch baseline to update.
updatePatchBaseline_baselineId :: Lens.Lens' UpdatePatchBaseline Prelude.Text
updatePatchBaseline_baselineId :: Lens' UpdatePatchBaseline Text
updatePatchBaseline_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaseline' {Text
baselineId :: Text
$sel:baselineId:UpdatePatchBaseline' :: UpdatePatchBaseline -> Text
baselineId} -> Text
baselineId) (\s :: UpdatePatchBaseline
s@UpdatePatchBaseline' {} Text
a -> UpdatePatchBaseline
s {$sel:baselineId:UpdatePatchBaseline' :: Text
baselineId = Text
a} :: UpdatePatchBaseline)

instance Core.AWSRequest UpdatePatchBaseline where
  type
    AWSResponse UpdatePatchBaseline =
      UpdatePatchBaselineResponse
  request :: (Service -> Service)
-> UpdatePatchBaseline -> Request UpdatePatchBaseline
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 UpdatePatchBaseline
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdatePatchBaseline)))
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 PatchRuleGroup
-> Maybe [Text]
-> Maybe PatchComplianceLevel
-> Maybe Bool
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe PatchFilterGroup
-> Maybe POSIX
-> Maybe Text
-> Maybe OperatingSystem
-> Maybe [Text]
-> Maybe PatchAction
-> Maybe [PatchSource]
-> Int
-> UpdatePatchBaselineResponse
UpdatePatchBaselineResponse'
            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
"ApprovalRules")
            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
"ApprovedPatches"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"ApprovedPatchesComplianceLevel")
            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
"ApprovedPatchesEnableNonSecurity")
            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
"BaselineId")
            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
"CreatedDate")
            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
"Description")
            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
"GlobalFilters")
            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
"ModifiedDate")
            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
"Name")
            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
"OperatingSystem")
            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
"RejectedPatches"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"RejectedPatchesAction")
            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
"Sources" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 UpdatePatchBaseline where
  hashWithSalt :: Int -> UpdatePatchBaseline -> Int
hashWithSalt Int
_salt UpdatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe Text
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
baselineId :: Text
sources :: Maybe [PatchSource]
replace :: Maybe Bool
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
name :: Maybe Text
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:baselineId:UpdatePatchBaseline' :: UpdatePatchBaseline -> Text
$sel:sources:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [PatchSource]
$sel:replace:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:rejectedPatchesAction:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:name:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:globalFilters:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:approvalRules:UpdatePatchBaseline' :: UpdatePatchBaseline -> 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
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PatchFilterGroup
globalFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      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 Bool
replace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PatchSource]
sources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
baselineId

instance Prelude.NFData UpdatePatchBaseline where
  rnf :: UpdatePatchBaseline -> ()
rnf UpdatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe Text
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
baselineId :: Text
sources :: Maybe [PatchSource]
replace :: Maybe Bool
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
name :: Maybe Text
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:baselineId:UpdatePatchBaseline' :: UpdatePatchBaseline -> Text
$sel:sources:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [PatchSource]
$sel:replace:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:rejectedPatchesAction:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:name:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:globalFilters:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:approvalRules:UpdatePatchBaseline' :: UpdatePatchBaseline -> 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
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 Text
name
      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 Bool
replace
      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 Text
baselineId

instance Data.ToHeaders UpdatePatchBaseline where
  toHeaders :: UpdatePatchBaseline -> 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.UpdatePatchBaseline" ::
                          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 UpdatePatchBaseline where
  toJSON :: UpdatePatchBaseline -> Value
toJSON UpdatePatchBaseline' {Maybe Bool
Maybe [Text]
Maybe [PatchSource]
Maybe Text
Maybe PatchAction
Maybe PatchComplianceLevel
Maybe PatchFilterGroup
Maybe PatchRuleGroup
Text
baselineId :: Text
sources :: Maybe [PatchSource]
replace :: Maybe Bool
rejectedPatchesAction :: Maybe PatchAction
rejectedPatches :: Maybe [Text]
name :: Maybe Text
globalFilters :: Maybe PatchFilterGroup
description :: Maybe Text
approvedPatchesEnableNonSecurity :: Maybe Bool
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
approvedPatches :: Maybe [Text]
approvalRules :: Maybe PatchRuleGroup
$sel:baselineId:UpdatePatchBaseline' :: UpdatePatchBaseline -> Text
$sel:sources:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [PatchSource]
$sel:replace:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:rejectedPatchesAction:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchAction
$sel:rejectedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:name:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:globalFilters:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchFilterGroup
$sel:description:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Text
$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe Bool
$sel:approvedPatchesComplianceLevel:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe PatchComplianceLevel
$sel:approvedPatches:UpdatePatchBaseline' :: UpdatePatchBaseline -> Maybe [Text]
$sel:approvalRules:UpdatePatchBaseline' :: UpdatePatchBaseline -> 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
"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
"Name" 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
name,
            (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
"Replace" 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
replace,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"BaselineId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
baselineId)
          ]
      )

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

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

-- | /See:/ 'newUpdatePatchBaselineResponse' smart constructor.
data UpdatePatchBaselineResponse = UpdatePatchBaselineResponse'
  { -- | A set of rules used to include patches in the baseline.
    UpdatePatchBaselineResponse -> Maybe PatchRuleGroup
approvalRules :: Prelude.Maybe PatchRuleGroup,
    -- | A list of explicitly approved patches for the baseline.
    UpdatePatchBaselineResponse -> Maybe [Text]
approvedPatches :: Prelude.Maybe [Prelude.Text],
    -- | The compliance severity level assigned to the patch baseline after the
    -- update completed.
    UpdatePatchBaselineResponse -> 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.
    UpdatePatchBaselineResponse -> Maybe Bool
approvedPatchesEnableNonSecurity :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the deleted patch baseline.
    UpdatePatchBaselineResponse -> Maybe Text
baselineId :: Prelude.Maybe Prelude.Text,
    -- | The date when the patch baseline was created.
    UpdatePatchBaselineResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | A description of the patch baseline.
    UpdatePatchBaselineResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A set of global filters used to exclude patches from the baseline.
    UpdatePatchBaselineResponse -> Maybe PatchFilterGroup
globalFilters :: Prelude.Maybe PatchFilterGroup,
    -- | The date when the patch baseline was last modified.
    UpdatePatchBaselineResponse -> Maybe POSIX
modifiedDate :: Prelude.Maybe Data.POSIX,
    -- | The name of the patch baseline.
    UpdatePatchBaselineResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The operating system rule used by the updated patch baseline.
    UpdatePatchBaselineResponse -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | A list of explicitly rejected patches for the baseline.
    UpdatePatchBaselineResponse -> Maybe [Text]
rejectedPatches :: Prelude.Maybe [Prelude.Text],
    -- | The action specified to take on patches included in the
    -- @RejectedPatches@ list. A patch can be allowed only if it is a
    -- dependency of another package, or blocked entirely along with packages
    -- that include it as a dependency.
    UpdatePatchBaselineResponse -> 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.
    UpdatePatchBaselineResponse -> Maybe [PatchSource]
sources :: Prelude.Maybe [PatchSource],
    -- | The response's http status code.
    UpdatePatchBaselineResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePatchBaselineResponse -> UpdatePatchBaselineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePatchBaselineResponse -> UpdatePatchBaselineResponse -> Bool
$c/= :: UpdatePatchBaselineResponse -> UpdatePatchBaselineResponse -> Bool
== :: UpdatePatchBaselineResponse -> UpdatePatchBaselineResponse -> Bool
$c== :: UpdatePatchBaselineResponse -> UpdatePatchBaselineResponse -> Bool
Prelude.Eq, Int -> UpdatePatchBaselineResponse -> ShowS
[UpdatePatchBaselineResponse] -> ShowS
UpdatePatchBaselineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePatchBaselineResponse] -> ShowS
$cshowList :: [UpdatePatchBaselineResponse] -> ShowS
show :: UpdatePatchBaselineResponse -> String
$cshow :: UpdatePatchBaselineResponse -> String
showsPrec :: Int -> UpdatePatchBaselineResponse -> ShowS
$cshowsPrec :: Int -> UpdatePatchBaselineResponse -> ShowS
Prelude.Show, forall x.
Rep UpdatePatchBaselineResponse x -> UpdatePatchBaselineResponse
forall x.
UpdatePatchBaselineResponse -> Rep UpdatePatchBaselineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePatchBaselineResponse x -> UpdatePatchBaselineResponse
$cfrom :: forall x.
UpdatePatchBaselineResponse -> Rep UpdatePatchBaselineResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePatchBaselineResponse' 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', 'updatePatchBaselineResponse_approvalRules' - A set of rules used to include patches in the baseline.
--
-- 'approvedPatches', 'updatePatchBaselineResponse_approvedPatches' - A list of explicitly approved patches for the baseline.
--
-- 'approvedPatchesComplianceLevel', 'updatePatchBaselineResponse_approvedPatchesComplianceLevel' - The compliance severity level assigned to the patch baseline after the
-- update completed.
--
-- 'approvedPatchesEnableNonSecurity', 'updatePatchBaselineResponse_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.
--
-- 'baselineId', 'updatePatchBaselineResponse_baselineId' - The ID of the deleted patch baseline.
--
-- 'createdDate', 'updatePatchBaselineResponse_createdDate' - The date when the patch baseline was created.
--
-- 'description', 'updatePatchBaselineResponse_description' - A description of the patch baseline.
--
-- 'globalFilters', 'updatePatchBaselineResponse_globalFilters' - A set of global filters used to exclude patches from the baseline.
--
-- 'modifiedDate', 'updatePatchBaselineResponse_modifiedDate' - The date when the patch baseline was last modified.
--
-- 'name', 'updatePatchBaselineResponse_name' - The name of the patch baseline.
--
-- 'operatingSystem', 'updatePatchBaselineResponse_operatingSystem' - The operating system rule used by the updated patch baseline.
--
-- 'rejectedPatches', 'updatePatchBaselineResponse_rejectedPatches' - A list of explicitly rejected patches for the baseline.
--
-- 'rejectedPatchesAction', 'updatePatchBaselineResponse_rejectedPatchesAction' - The action specified to take on patches included in the
-- @RejectedPatches@ list. A patch can be allowed only if it is a
-- dependency of another package, or blocked entirely along with packages
-- that include it as a dependency.
--
-- 'sources', 'updatePatchBaselineResponse_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.
--
-- 'httpStatus', 'updatePatchBaselineResponse_httpStatus' - The response's http status code.
newUpdatePatchBaselineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePatchBaselineResponse
newUpdatePatchBaselineResponse :: Int -> UpdatePatchBaselineResponse
newUpdatePatchBaselineResponse Int
pHttpStatus_ =
  UpdatePatchBaselineResponse'
    { $sel:approvalRules:UpdatePatchBaselineResponse' :: Maybe PatchRuleGroup
approvalRules =
        forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatches:UpdatePatchBaselineResponse' :: Maybe [Text]
approvedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesComplianceLevel:UpdatePatchBaselineResponse' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel =
        forall a. Maybe a
Prelude.Nothing,
      $sel:approvedPatchesEnableNonSecurity:UpdatePatchBaselineResponse' :: Maybe Bool
approvedPatchesEnableNonSecurity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:baselineId:UpdatePatchBaselineResponse' :: Maybe Text
baselineId = forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:UpdatePatchBaselineResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdatePatchBaselineResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:globalFilters:UpdatePatchBaselineResponse' :: Maybe PatchFilterGroup
globalFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:modifiedDate:UpdatePatchBaselineResponse' :: Maybe POSIX
modifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdatePatchBaselineResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:UpdatePatchBaselineResponse' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatches:UpdatePatchBaselineResponse' :: Maybe [Text]
rejectedPatches = forall a. Maybe a
Prelude.Nothing,
      $sel:rejectedPatchesAction:UpdatePatchBaselineResponse' :: Maybe PatchAction
rejectedPatchesAction = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:UpdatePatchBaselineResponse' :: Maybe [PatchSource]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePatchBaselineResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A list of explicitly approved patches for the baseline.
updatePatchBaselineResponse_approvedPatches :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe [Prelude.Text])
updatePatchBaselineResponse_approvedPatches :: Lens' UpdatePatchBaselineResponse (Maybe [Text])
updatePatchBaselineResponse_approvedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe [Text]
approvedPatches :: Maybe [Text]
$sel:approvedPatches:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe [Text]
approvedPatches} -> Maybe [Text]
approvedPatches) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe [Text]
a -> UpdatePatchBaselineResponse
s {$sel:approvedPatches:UpdatePatchBaselineResponse' :: Maybe [Text]
approvedPatches = Maybe [Text]
a} :: UpdatePatchBaselineResponse) 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 compliance severity level assigned to the patch baseline after the
-- update completed.
updatePatchBaselineResponse_approvedPatchesComplianceLevel :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe PatchComplianceLevel)
updatePatchBaselineResponse_approvedPatchesComplianceLevel :: Lens' UpdatePatchBaselineResponse (Maybe PatchComplianceLevel)
updatePatchBaselineResponse_approvedPatchesComplianceLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe PatchComplianceLevel
approvedPatchesComplianceLevel :: Maybe PatchComplianceLevel
$sel:approvedPatchesComplianceLevel:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel} -> Maybe PatchComplianceLevel
approvedPatchesComplianceLevel) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe PatchComplianceLevel
a -> UpdatePatchBaselineResponse
s {$sel:approvedPatchesComplianceLevel:UpdatePatchBaselineResponse' :: Maybe PatchComplianceLevel
approvedPatchesComplianceLevel = Maybe PatchComplianceLevel
a} :: UpdatePatchBaselineResponse)

-- | 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.
updatePatchBaselineResponse_approvedPatchesEnableNonSecurity :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe Prelude.Bool)
updatePatchBaselineResponse_approvedPatchesEnableNonSecurity :: Lens' UpdatePatchBaselineResponse (Maybe Bool)
updatePatchBaselineResponse_approvedPatchesEnableNonSecurity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe Bool
approvedPatchesEnableNonSecurity :: Maybe Bool
$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe Bool
approvedPatchesEnableNonSecurity} -> Maybe Bool
approvedPatchesEnableNonSecurity) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe Bool
a -> UpdatePatchBaselineResponse
s {$sel:approvedPatchesEnableNonSecurity:UpdatePatchBaselineResponse' :: Maybe Bool
approvedPatchesEnableNonSecurity = Maybe Bool
a} :: UpdatePatchBaselineResponse)

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

-- | The date when the patch baseline was created.
updatePatchBaselineResponse_createdDate :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe Prelude.UTCTime)
updatePatchBaselineResponse_createdDate :: Lens' UpdatePatchBaselineResponse (Maybe UTCTime)
updatePatchBaselineResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe POSIX
a -> UpdatePatchBaselineResponse
s {$sel:createdDate:UpdatePatchBaselineResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: UpdatePatchBaselineResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

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

-- | The date when the patch baseline was last modified.
updatePatchBaselineResponse_modifiedDate :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe Prelude.UTCTime)
updatePatchBaselineResponse_modifiedDate :: Lens' UpdatePatchBaselineResponse (Maybe UTCTime)
updatePatchBaselineResponse_modifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe POSIX
modifiedDate :: Maybe POSIX
$sel:modifiedDate:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe POSIX
modifiedDate} -> Maybe POSIX
modifiedDate) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe POSIX
a -> UpdatePatchBaselineResponse
s {$sel:modifiedDate:UpdatePatchBaselineResponse' :: Maybe POSIX
modifiedDate = Maybe POSIX
a} :: UpdatePatchBaselineResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The operating system rule used by the updated patch baseline.
updatePatchBaselineResponse_operatingSystem :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe OperatingSystem)
updatePatchBaselineResponse_operatingSystem :: Lens' UpdatePatchBaselineResponse (Maybe OperatingSystem)
updatePatchBaselineResponse_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe OperatingSystem
a -> UpdatePatchBaselineResponse
s {$sel:operatingSystem:UpdatePatchBaselineResponse' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: UpdatePatchBaselineResponse)

-- | A list of explicitly rejected patches for the baseline.
updatePatchBaselineResponse_rejectedPatches :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe [Prelude.Text])
updatePatchBaselineResponse_rejectedPatches :: Lens' UpdatePatchBaselineResponse (Maybe [Text])
updatePatchBaselineResponse_rejectedPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe [Text]
rejectedPatches :: Maybe [Text]
$sel:rejectedPatches:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe [Text]
rejectedPatches} -> Maybe [Text]
rejectedPatches) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe [Text]
a -> UpdatePatchBaselineResponse
s {$sel:rejectedPatches:UpdatePatchBaselineResponse' :: Maybe [Text]
rejectedPatches = Maybe [Text]
a} :: UpdatePatchBaselineResponse) 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 specified to take on patches included in the
-- @RejectedPatches@ list. A patch can be allowed only if it is a
-- dependency of another package, or blocked entirely along with packages
-- that include it as a dependency.
updatePatchBaselineResponse_rejectedPatchesAction :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe PatchAction)
updatePatchBaselineResponse_rejectedPatchesAction :: Lens' UpdatePatchBaselineResponse (Maybe PatchAction)
updatePatchBaselineResponse_rejectedPatchesAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe PatchAction
rejectedPatchesAction :: Maybe PatchAction
$sel:rejectedPatchesAction:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe PatchAction
rejectedPatchesAction} -> Maybe PatchAction
rejectedPatchesAction) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe PatchAction
a -> UpdatePatchBaselineResponse
s {$sel:rejectedPatchesAction:UpdatePatchBaselineResponse' :: Maybe PatchAction
rejectedPatchesAction = Maybe PatchAction
a} :: UpdatePatchBaselineResponse)

-- | Information about the patches to use to update the managed nodes,
-- including target operating systems and source repositories. Applies to
-- Linux managed nodes only.
updatePatchBaselineResponse_sources :: Lens.Lens' UpdatePatchBaselineResponse (Prelude.Maybe [PatchSource])
updatePatchBaselineResponse_sources :: Lens' UpdatePatchBaselineResponse (Maybe [PatchSource])
updatePatchBaselineResponse_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Maybe [PatchSource]
sources :: Maybe [PatchSource]
$sel:sources:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Maybe [PatchSource]
sources} -> Maybe [PatchSource]
sources) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Maybe [PatchSource]
a -> UpdatePatchBaselineResponse
s {$sel:sources:UpdatePatchBaselineResponse' :: Maybe [PatchSource]
sources = Maybe [PatchSource]
a} :: UpdatePatchBaselineResponse) 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 response's http status code.
updatePatchBaselineResponse_httpStatus :: Lens.Lens' UpdatePatchBaselineResponse Prelude.Int
updatePatchBaselineResponse_httpStatus :: Lens' UpdatePatchBaselineResponse Int
updatePatchBaselineResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePatchBaselineResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdatePatchBaselineResponse' :: UpdatePatchBaselineResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdatePatchBaselineResponse
s@UpdatePatchBaselineResponse' {} Int
a -> UpdatePatchBaselineResponse
s {$sel:httpStatus:UpdatePatchBaselineResponse' :: Int
httpStatus = Int
a} :: UpdatePatchBaselineResponse)

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