{-# 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.DescribeEffectivePatchesForPatchBaseline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the current effective patches (the patch and the approval
-- state) for the specified patch baseline. Applies to patch baselines for
-- Windows only.
--
-- This operation returns paginated results.
module Amazonka.SSM.DescribeEffectivePatchesForPatchBaseline
  ( -- * Creating a Request
    DescribeEffectivePatchesForPatchBaseline (..),
    newDescribeEffectivePatchesForPatchBaseline,

    -- * Request Lenses
    describeEffectivePatchesForPatchBaseline_maxResults,
    describeEffectivePatchesForPatchBaseline_nextToken,
    describeEffectivePatchesForPatchBaseline_baselineId,

    -- * Destructuring the Response
    DescribeEffectivePatchesForPatchBaselineResponse (..),
    newDescribeEffectivePatchesForPatchBaselineResponse,

    -- * Response Lenses
    describeEffectivePatchesForPatchBaselineResponse_effectivePatches,
    describeEffectivePatchesForPatchBaselineResponse_nextToken,
    describeEffectivePatchesForPatchBaselineResponse_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:/ 'newDescribeEffectivePatchesForPatchBaseline' smart constructor.
data DescribeEffectivePatchesForPatchBaseline = DescribeEffectivePatchesForPatchBaseline'
  { -- | The maximum number of patches to return (per page).
    DescribeEffectivePatchesForPatchBaseline -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of items to return. (You received this token
    -- from a previous call.)
    DescribeEffectivePatchesForPatchBaseline -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the patch baseline to retrieve the effective patches for.
    DescribeEffectivePatchesForPatchBaseline -> Text
baselineId :: Prelude.Text
  }
  deriving (DescribeEffectivePatchesForPatchBaseline
-> DescribeEffectivePatchesForPatchBaseline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEffectivePatchesForPatchBaseline
-> DescribeEffectivePatchesForPatchBaseline -> Bool
$c/= :: DescribeEffectivePatchesForPatchBaseline
-> DescribeEffectivePatchesForPatchBaseline -> Bool
== :: DescribeEffectivePatchesForPatchBaseline
-> DescribeEffectivePatchesForPatchBaseline -> Bool
$c== :: DescribeEffectivePatchesForPatchBaseline
-> DescribeEffectivePatchesForPatchBaseline -> Bool
Prelude.Eq, ReadPrec [DescribeEffectivePatchesForPatchBaseline]
ReadPrec DescribeEffectivePatchesForPatchBaseline
Int -> ReadS DescribeEffectivePatchesForPatchBaseline
ReadS [DescribeEffectivePatchesForPatchBaseline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEffectivePatchesForPatchBaseline]
$creadListPrec :: ReadPrec [DescribeEffectivePatchesForPatchBaseline]
readPrec :: ReadPrec DescribeEffectivePatchesForPatchBaseline
$creadPrec :: ReadPrec DescribeEffectivePatchesForPatchBaseline
readList :: ReadS [DescribeEffectivePatchesForPatchBaseline]
$creadList :: ReadS [DescribeEffectivePatchesForPatchBaseline]
readsPrec :: Int -> ReadS DescribeEffectivePatchesForPatchBaseline
$creadsPrec :: Int -> ReadS DescribeEffectivePatchesForPatchBaseline
Prelude.Read, Int -> DescribeEffectivePatchesForPatchBaseline -> ShowS
[DescribeEffectivePatchesForPatchBaseline] -> ShowS
DescribeEffectivePatchesForPatchBaseline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEffectivePatchesForPatchBaseline] -> ShowS
$cshowList :: [DescribeEffectivePatchesForPatchBaseline] -> ShowS
show :: DescribeEffectivePatchesForPatchBaseline -> String
$cshow :: DescribeEffectivePatchesForPatchBaseline -> String
showsPrec :: Int -> DescribeEffectivePatchesForPatchBaseline -> ShowS
$cshowsPrec :: Int -> DescribeEffectivePatchesForPatchBaseline -> ShowS
Prelude.Show, forall x.
Rep DescribeEffectivePatchesForPatchBaseline x
-> DescribeEffectivePatchesForPatchBaseline
forall x.
DescribeEffectivePatchesForPatchBaseline
-> Rep DescribeEffectivePatchesForPatchBaseline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEffectivePatchesForPatchBaseline x
-> DescribeEffectivePatchesForPatchBaseline
$cfrom :: forall x.
DescribeEffectivePatchesForPatchBaseline
-> Rep DescribeEffectivePatchesForPatchBaseline x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEffectivePatchesForPatchBaseline' 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:
--
-- 'maxResults', 'describeEffectivePatchesForPatchBaseline_maxResults' - The maximum number of patches to return (per page).
--
-- 'nextToken', 'describeEffectivePatchesForPatchBaseline_nextToken' - The token for the next set of items to return. (You received this token
-- from a previous call.)
--
-- 'baselineId', 'describeEffectivePatchesForPatchBaseline_baselineId' - The ID of the patch baseline to retrieve the effective patches for.
newDescribeEffectivePatchesForPatchBaseline ::
  -- | 'baselineId'
  Prelude.Text ->
  DescribeEffectivePatchesForPatchBaseline
newDescribeEffectivePatchesForPatchBaseline :: Text -> DescribeEffectivePatchesForPatchBaseline
newDescribeEffectivePatchesForPatchBaseline
  Text
pBaselineId_ =
    DescribeEffectivePatchesForPatchBaseline'
      { $sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: Maybe Natural
maxResults =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: Text
baselineId = Text
pBaselineId_
      }

-- | The maximum number of patches to return (per page).
describeEffectivePatchesForPatchBaseline_maxResults :: Lens.Lens' DescribeEffectivePatchesForPatchBaseline (Prelude.Maybe Prelude.Natural)
describeEffectivePatchesForPatchBaseline_maxResults :: Lens' DescribeEffectivePatchesForPatchBaseline (Maybe Natural)
describeEffectivePatchesForPatchBaseline_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePatchesForPatchBaseline' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeEffectivePatchesForPatchBaseline
s@DescribeEffectivePatchesForPatchBaseline' {} Maybe Natural
a -> DescribeEffectivePatchesForPatchBaseline
s {$sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeEffectivePatchesForPatchBaseline)

-- | The token for the next set of items to return. (You received this token
-- from a previous call.)
describeEffectivePatchesForPatchBaseline_nextToken :: Lens.Lens' DescribeEffectivePatchesForPatchBaseline (Prelude.Maybe Prelude.Text)
describeEffectivePatchesForPatchBaseline_nextToken :: Lens' DescribeEffectivePatchesForPatchBaseline (Maybe Text)
describeEffectivePatchesForPatchBaseline_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePatchesForPatchBaseline' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeEffectivePatchesForPatchBaseline
s@DescribeEffectivePatchesForPatchBaseline' {} Maybe Text
a -> DescribeEffectivePatchesForPatchBaseline
s {$sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeEffectivePatchesForPatchBaseline)

-- | The ID of the patch baseline to retrieve the effective patches for.
describeEffectivePatchesForPatchBaseline_baselineId :: Lens.Lens' DescribeEffectivePatchesForPatchBaseline Prelude.Text
describeEffectivePatchesForPatchBaseline_baselineId :: Lens' DescribeEffectivePatchesForPatchBaseline Text
describeEffectivePatchesForPatchBaseline_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePatchesForPatchBaseline' {Text
baselineId :: Text
$sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Text
baselineId} -> Text
baselineId) (\s :: DescribeEffectivePatchesForPatchBaseline
s@DescribeEffectivePatchesForPatchBaseline' {} Text
a -> DescribeEffectivePatchesForPatchBaseline
s {$sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: Text
baselineId = Text
a} :: DescribeEffectivePatchesForPatchBaseline)

instance
  Core.AWSPager
    DescribeEffectivePatchesForPatchBaseline
  where
  page :: DescribeEffectivePatchesForPatchBaseline
-> AWSResponse DescribeEffectivePatchesForPatchBaseline
-> Maybe DescribeEffectivePatchesForPatchBaseline
page DescribeEffectivePatchesForPatchBaseline
rq AWSResponse DescribeEffectivePatchesForPatchBaseline
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEffectivePatchesForPatchBaseline
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEffectivePatchesForPatchBaselineResponse (Maybe Text)
describeEffectivePatchesForPatchBaselineResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEffectivePatchesForPatchBaseline
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeEffectivePatchesForPatchBaselineResponse
  (Maybe [EffectivePatch])
describeEffectivePatchesForPatchBaselineResponse_effectivePatches
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeEffectivePatchesForPatchBaseline
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeEffectivePatchesForPatchBaseline (Maybe Text)
describeEffectivePatchesForPatchBaseline_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeEffectivePatchesForPatchBaseline
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEffectivePatchesForPatchBaselineResponse (Maybe Text)
describeEffectivePatchesForPatchBaselineResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance
  Core.AWSRequest
    DescribeEffectivePatchesForPatchBaseline
  where
  type
    AWSResponse
      DescribeEffectivePatchesForPatchBaseline =
      DescribeEffectivePatchesForPatchBaselineResponse
  request :: (Service -> Service)
-> DescribeEffectivePatchesForPatchBaseline
-> Request DescribeEffectivePatchesForPatchBaseline
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 DescribeEffectivePatchesForPatchBaseline
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DescribeEffectivePatchesForPatchBaseline)))
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 [EffectivePatch]
-> Maybe Text
-> Int
-> DescribeEffectivePatchesForPatchBaselineResponse
DescribeEffectivePatchesForPatchBaselineResponse'
            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
"EffectivePatches"
                            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
"NextToken")
            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
    DescribeEffectivePatchesForPatchBaseline
  where
  hashWithSalt :: Int -> DescribeEffectivePatchesForPatchBaseline -> Int
hashWithSalt
    Int
_salt
    DescribeEffectivePatchesForPatchBaseline' {Maybe Natural
Maybe Text
Text
baselineId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Text
$sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Text
$sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Natural
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
baselineId

instance
  Prelude.NFData
    DescribeEffectivePatchesForPatchBaseline
  where
  rnf :: DescribeEffectivePatchesForPatchBaseline -> ()
rnf DescribeEffectivePatchesForPatchBaseline' {Maybe Natural
Maybe Text
Text
baselineId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Text
$sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Text
$sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
baselineId

instance
  Data.ToHeaders
    DescribeEffectivePatchesForPatchBaseline
  where
  toHeaders :: DescribeEffectivePatchesForPatchBaseline -> 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.DescribeEffectivePatchesForPatchBaseline" ::
                          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
    DescribeEffectivePatchesForPatchBaseline
  where
  toJSON :: DescribeEffectivePatchesForPatchBaseline -> Value
toJSON DescribeEffectivePatchesForPatchBaseline' {Maybe Natural
Maybe Text
Text
baselineId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:baselineId:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Text
$sel:nextToken:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Text
$sel:maxResults:DescribeEffectivePatchesForPatchBaseline' :: DescribeEffectivePatchesForPatchBaseline -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            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
    DescribeEffectivePatchesForPatchBaseline
  where
  toPath :: DescribeEffectivePatchesForPatchBaseline -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeEffectivePatchesForPatchBaselineResponse' smart constructor.
data DescribeEffectivePatchesForPatchBaselineResponse = DescribeEffectivePatchesForPatchBaselineResponse'
  { -- | An array of patches and patch status.
    DescribeEffectivePatchesForPatchBaselineResponse
-> Maybe [EffectivePatch]
effectivePatches :: Prelude.Maybe [EffectivePatch],
    -- | The token to use when requesting the next set of items. If there are no
    -- additional items to return, the string is empty.
    DescribeEffectivePatchesForPatchBaselineResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeEffectivePatchesForPatchBaselineResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEffectivePatchesForPatchBaselineResponse
-> DescribeEffectivePatchesForPatchBaselineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEffectivePatchesForPatchBaselineResponse
-> DescribeEffectivePatchesForPatchBaselineResponse -> Bool
$c/= :: DescribeEffectivePatchesForPatchBaselineResponse
-> DescribeEffectivePatchesForPatchBaselineResponse -> Bool
== :: DescribeEffectivePatchesForPatchBaselineResponse
-> DescribeEffectivePatchesForPatchBaselineResponse -> Bool
$c== :: DescribeEffectivePatchesForPatchBaselineResponse
-> DescribeEffectivePatchesForPatchBaselineResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEffectivePatchesForPatchBaselineResponse]
ReadPrec DescribeEffectivePatchesForPatchBaselineResponse
Int -> ReadS DescribeEffectivePatchesForPatchBaselineResponse
ReadS [DescribeEffectivePatchesForPatchBaselineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEffectivePatchesForPatchBaselineResponse]
$creadListPrec :: ReadPrec [DescribeEffectivePatchesForPatchBaselineResponse]
readPrec :: ReadPrec DescribeEffectivePatchesForPatchBaselineResponse
$creadPrec :: ReadPrec DescribeEffectivePatchesForPatchBaselineResponse
readList :: ReadS [DescribeEffectivePatchesForPatchBaselineResponse]
$creadList :: ReadS [DescribeEffectivePatchesForPatchBaselineResponse]
readsPrec :: Int -> ReadS DescribeEffectivePatchesForPatchBaselineResponse
$creadsPrec :: Int -> ReadS DescribeEffectivePatchesForPatchBaselineResponse
Prelude.Read, Int -> DescribeEffectivePatchesForPatchBaselineResponse -> ShowS
[DescribeEffectivePatchesForPatchBaselineResponse] -> ShowS
DescribeEffectivePatchesForPatchBaselineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEffectivePatchesForPatchBaselineResponse] -> ShowS
$cshowList :: [DescribeEffectivePatchesForPatchBaselineResponse] -> ShowS
show :: DescribeEffectivePatchesForPatchBaselineResponse -> String
$cshow :: DescribeEffectivePatchesForPatchBaselineResponse -> String
showsPrec :: Int -> DescribeEffectivePatchesForPatchBaselineResponse -> ShowS
$cshowsPrec :: Int -> DescribeEffectivePatchesForPatchBaselineResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEffectivePatchesForPatchBaselineResponse x
-> DescribeEffectivePatchesForPatchBaselineResponse
forall x.
DescribeEffectivePatchesForPatchBaselineResponse
-> Rep DescribeEffectivePatchesForPatchBaselineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEffectivePatchesForPatchBaselineResponse x
-> DescribeEffectivePatchesForPatchBaselineResponse
$cfrom :: forall x.
DescribeEffectivePatchesForPatchBaselineResponse
-> Rep DescribeEffectivePatchesForPatchBaselineResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEffectivePatchesForPatchBaselineResponse' 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:
--
-- 'effectivePatches', 'describeEffectivePatchesForPatchBaselineResponse_effectivePatches' - An array of patches and patch status.
--
-- 'nextToken', 'describeEffectivePatchesForPatchBaselineResponse_nextToken' - The token to use when requesting the next set of items. If there are no
-- additional items to return, the string is empty.
--
-- 'httpStatus', 'describeEffectivePatchesForPatchBaselineResponse_httpStatus' - The response's http status code.
newDescribeEffectivePatchesForPatchBaselineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEffectivePatchesForPatchBaselineResponse
newDescribeEffectivePatchesForPatchBaselineResponse :: Int -> DescribeEffectivePatchesForPatchBaselineResponse
newDescribeEffectivePatchesForPatchBaselineResponse
  Int
pHttpStatus_ =
    DescribeEffectivePatchesForPatchBaselineResponse'
      { $sel:effectivePatches:DescribeEffectivePatchesForPatchBaselineResponse' :: Maybe [EffectivePatch]
effectivePatches =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeEffectivePatchesForPatchBaselineResponse' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeEffectivePatchesForPatchBaselineResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An array of patches and patch status.
describeEffectivePatchesForPatchBaselineResponse_effectivePatches :: Lens.Lens' DescribeEffectivePatchesForPatchBaselineResponse (Prelude.Maybe [EffectivePatch])
describeEffectivePatchesForPatchBaselineResponse_effectivePatches :: Lens'
  DescribeEffectivePatchesForPatchBaselineResponse
  (Maybe [EffectivePatch])
describeEffectivePatchesForPatchBaselineResponse_effectivePatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePatchesForPatchBaselineResponse' {Maybe [EffectivePatch]
effectivePatches :: Maybe [EffectivePatch]
$sel:effectivePatches:DescribeEffectivePatchesForPatchBaselineResponse' :: DescribeEffectivePatchesForPatchBaselineResponse
-> Maybe [EffectivePatch]
effectivePatches} -> Maybe [EffectivePatch]
effectivePatches) (\s :: DescribeEffectivePatchesForPatchBaselineResponse
s@DescribeEffectivePatchesForPatchBaselineResponse' {} Maybe [EffectivePatch]
a -> DescribeEffectivePatchesForPatchBaselineResponse
s {$sel:effectivePatches:DescribeEffectivePatchesForPatchBaselineResponse' :: Maybe [EffectivePatch]
effectivePatches = Maybe [EffectivePatch]
a} :: DescribeEffectivePatchesForPatchBaselineResponse) 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 token to use when requesting the next set of items. If there are no
-- additional items to return, the string is empty.
describeEffectivePatchesForPatchBaselineResponse_nextToken :: Lens.Lens' DescribeEffectivePatchesForPatchBaselineResponse (Prelude.Maybe Prelude.Text)
describeEffectivePatchesForPatchBaselineResponse_nextToken :: Lens' DescribeEffectivePatchesForPatchBaselineResponse (Maybe Text)
describeEffectivePatchesForPatchBaselineResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePatchesForPatchBaselineResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeEffectivePatchesForPatchBaselineResponse' :: DescribeEffectivePatchesForPatchBaselineResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeEffectivePatchesForPatchBaselineResponse
s@DescribeEffectivePatchesForPatchBaselineResponse' {} Maybe Text
a -> DescribeEffectivePatchesForPatchBaselineResponse
s {$sel:nextToken:DescribeEffectivePatchesForPatchBaselineResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeEffectivePatchesForPatchBaselineResponse)

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

instance
  Prelude.NFData
    DescribeEffectivePatchesForPatchBaselineResponse
  where
  rnf :: DescribeEffectivePatchesForPatchBaselineResponse -> ()
rnf
    DescribeEffectivePatchesForPatchBaselineResponse' {Int
Maybe [EffectivePatch]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
effectivePatches :: Maybe [EffectivePatch]
$sel:httpStatus:DescribeEffectivePatchesForPatchBaselineResponse' :: DescribeEffectivePatchesForPatchBaselineResponse -> Int
$sel:nextToken:DescribeEffectivePatchesForPatchBaselineResponse' :: DescribeEffectivePatchesForPatchBaselineResponse -> Maybe Text
$sel:effectivePatches:DescribeEffectivePatchesForPatchBaselineResponse' :: DescribeEffectivePatchesForPatchBaselineResponse
-> Maybe [EffectivePatch]
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe [EffectivePatch]
effectivePatches
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus