{-# 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.GetPatchBaselineForPatchGroup
-- 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 patch baseline that should be used for the specified patch
-- group.
module Amazonka.SSM.GetPatchBaselineForPatchGroup
  ( -- * Creating a Request
    GetPatchBaselineForPatchGroup (..),
    newGetPatchBaselineForPatchGroup,

    -- * Request Lenses
    getPatchBaselineForPatchGroup_operatingSystem,
    getPatchBaselineForPatchGroup_patchGroup,

    -- * Destructuring the Response
    GetPatchBaselineForPatchGroupResponse (..),
    newGetPatchBaselineForPatchGroupResponse,

    -- * Response Lenses
    getPatchBaselineForPatchGroupResponse_baselineId,
    getPatchBaselineForPatchGroupResponse_operatingSystem,
    getPatchBaselineForPatchGroupResponse_patchGroup,
    getPatchBaselineForPatchGroupResponse_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:/ 'newGetPatchBaselineForPatchGroup' smart constructor.
data GetPatchBaselineForPatchGroup = GetPatchBaselineForPatchGroup'
  { -- | Returns the operating system rule specified for patch groups using the
    -- patch baseline.
    GetPatchBaselineForPatchGroup -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | The name of the patch group whose patch baseline should be retrieved.
    GetPatchBaselineForPatchGroup -> Text
patchGroup :: Prelude.Text
  }
  deriving (GetPatchBaselineForPatchGroup
-> GetPatchBaselineForPatchGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPatchBaselineForPatchGroup
-> GetPatchBaselineForPatchGroup -> Bool
$c/= :: GetPatchBaselineForPatchGroup
-> GetPatchBaselineForPatchGroup -> Bool
== :: GetPatchBaselineForPatchGroup
-> GetPatchBaselineForPatchGroup -> Bool
$c== :: GetPatchBaselineForPatchGroup
-> GetPatchBaselineForPatchGroup -> Bool
Prelude.Eq, ReadPrec [GetPatchBaselineForPatchGroup]
ReadPrec GetPatchBaselineForPatchGroup
Int -> ReadS GetPatchBaselineForPatchGroup
ReadS [GetPatchBaselineForPatchGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPatchBaselineForPatchGroup]
$creadListPrec :: ReadPrec [GetPatchBaselineForPatchGroup]
readPrec :: ReadPrec GetPatchBaselineForPatchGroup
$creadPrec :: ReadPrec GetPatchBaselineForPatchGroup
readList :: ReadS [GetPatchBaselineForPatchGroup]
$creadList :: ReadS [GetPatchBaselineForPatchGroup]
readsPrec :: Int -> ReadS GetPatchBaselineForPatchGroup
$creadsPrec :: Int -> ReadS GetPatchBaselineForPatchGroup
Prelude.Read, Int -> GetPatchBaselineForPatchGroup -> ShowS
[GetPatchBaselineForPatchGroup] -> ShowS
GetPatchBaselineForPatchGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPatchBaselineForPatchGroup] -> ShowS
$cshowList :: [GetPatchBaselineForPatchGroup] -> ShowS
show :: GetPatchBaselineForPatchGroup -> String
$cshow :: GetPatchBaselineForPatchGroup -> String
showsPrec :: Int -> GetPatchBaselineForPatchGroup -> ShowS
$cshowsPrec :: Int -> GetPatchBaselineForPatchGroup -> ShowS
Prelude.Show, forall x.
Rep GetPatchBaselineForPatchGroup x
-> GetPatchBaselineForPatchGroup
forall x.
GetPatchBaselineForPatchGroup
-> Rep GetPatchBaselineForPatchGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPatchBaselineForPatchGroup x
-> GetPatchBaselineForPatchGroup
$cfrom :: forall x.
GetPatchBaselineForPatchGroup
-> Rep GetPatchBaselineForPatchGroup x
Prelude.Generic)

-- |
-- Create a value of 'GetPatchBaselineForPatchGroup' 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:
--
-- 'operatingSystem', 'getPatchBaselineForPatchGroup_operatingSystem' - Returns the operating system rule specified for patch groups using the
-- patch baseline.
--
-- 'patchGroup', 'getPatchBaselineForPatchGroup_patchGroup' - The name of the patch group whose patch baseline should be retrieved.
newGetPatchBaselineForPatchGroup ::
  -- | 'patchGroup'
  Prelude.Text ->
  GetPatchBaselineForPatchGroup
newGetPatchBaselineForPatchGroup :: Text -> GetPatchBaselineForPatchGroup
newGetPatchBaselineForPatchGroup Text
pPatchGroup_ =
  GetPatchBaselineForPatchGroup'
    { $sel:operatingSystem:GetPatchBaselineForPatchGroup' :: Maybe OperatingSystem
operatingSystem =
        forall a. Maybe a
Prelude.Nothing,
      $sel:patchGroup:GetPatchBaselineForPatchGroup' :: Text
patchGroup = Text
pPatchGroup_
    }

-- | Returns the operating system rule specified for patch groups using the
-- patch baseline.
getPatchBaselineForPatchGroup_operatingSystem :: Lens.Lens' GetPatchBaselineForPatchGroup (Prelude.Maybe OperatingSystem)
getPatchBaselineForPatchGroup_operatingSystem :: Lens' GetPatchBaselineForPatchGroup (Maybe OperatingSystem)
getPatchBaselineForPatchGroup_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPatchBaselineForPatchGroup' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: GetPatchBaselineForPatchGroup
s@GetPatchBaselineForPatchGroup' {} Maybe OperatingSystem
a -> GetPatchBaselineForPatchGroup
s {$sel:operatingSystem:GetPatchBaselineForPatchGroup' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: GetPatchBaselineForPatchGroup)

-- | The name of the patch group whose patch baseline should be retrieved.
getPatchBaselineForPatchGroup_patchGroup :: Lens.Lens' GetPatchBaselineForPatchGroup Prelude.Text
getPatchBaselineForPatchGroup_patchGroup :: Lens' GetPatchBaselineForPatchGroup Text
getPatchBaselineForPatchGroup_patchGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPatchBaselineForPatchGroup' {Text
patchGroup :: Text
$sel:patchGroup:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Text
patchGroup} -> Text
patchGroup) (\s :: GetPatchBaselineForPatchGroup
s@GetPatchBaselineForPatchGroup' {} Text
a -> GetPatchBaselineForPatchGroup
s {$sel:patchGroup:GetPatchBaselineForPatchGroup' :: Text
patchGroup = Text
a} :: GetPatchBaselineForPatchGroup)

instance
  Core.AWSRequest
    GetPatchBaselineForPatchGroup
  where
  type
    AWSResponse GetPatchBaselineForPatchGroup =
      GetPatchBaselineForPatchGroupResponse
  request :: (Service -> Service)
-> GetPatchBaselineForPatchGroup
-> Request GetPatchBaselineForPatchGroup
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 GetPatchBaselineForPatchGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPatchBaselineForPatchGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe OperatingSystem
-> Maybe Text
-> Int
-> GetPatchBaselineForPatchGroupResponse
GetPatchBaselineForPatchGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"BaselineId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (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
"PatchGroup")
            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
    GetPatchBaselineForPatchGroup
  where
  hashWithSalt :: Int -> GetPatchBaselineForPatchGroup -> Int
hashWithSalt Int
_salt GetPatchBaselineForPatchGroup' {Maybe OperatingSystem
Text
patchGroup :: Text
operatingSystem :: Maybe OperatingSystem
$sel:patchGroup:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Text
$sel:operatingSystem:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Maybe OperatingSystem
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperatingSystem
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
patchGroup

instance Prelude.NFData GetPatchBaselineForPatchGroup where
  rnf :: GetPatchBaselineForPatchGroup -> ()
rnf GetPatchBaselineForPatchGroup' {Maybe OperatingSystem
Text
patchGroup :: Text
operatingSystem :: Maybe OperatingSystem
$sel:patchGroup:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Text
$sel:operatingSystem:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Maybe OperatingSystem
..} =
    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 Text
patchGroup

instance Data.ToHeaders GetPatchBaselineForPatchGroup where
  toHeaders :: GetPatchBaselineForPatchGroup -> 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.GetPatchBaselineForPatchGroup" ::
                          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 GetPatchBaselineForPatchGroup where
  toJSON :: GetPatchBaselineForPatchGroup -> Value
toJSON GetPatchBaselineForPatchGroup' {Maybe OperatingSystem
Text
patchGroup :: Text
operatingSystem :: Maybe OperatingSystem
$sel:patchGroup:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Text
$sel:operatingSystem:GetPatchBaselineForPatchGroup' :: GetPatchBaselineForPatchGroup -> Maybe OperatingSystem
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OperatingSystem" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OperatingSystem
operatingSystem,
            forall a. a -> Maybe a
Prelude.Just (Key
"PatchGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
patchGroup)
          ]
      )

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

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

-- | /See:/ 'newGetPatchBaselineForPatchGroupResponse' smart constructor.
data GetPatchBaselineForPatchGroupResponse = GetPatchBaselineForPatchGroupResponse'
  { -- | The ID of the patch baseline that should be used for the patch group.
    GetPatchBaselineForPatchGroupResponse -> Maybe Text
baselineId :: Prelude.Maybe Prelude.Text,
    -- | The operating system rule specified for patch groups using the patch
    -- baseline.
    GetPatchBaselineForPatchGroupResponse -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | The name of the patch group.
    GetPatchBaselineForPatchGroupResponse -> Maybe Text
patchGroup :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetPatchBaselineForPatchGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPatchBaselineForPatchGroupResponse
-> GetPatchBaselineForPatchGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPatchBaselineForPatchGroupResponse
-> GetPatchBaselineForPatchGroupResponse -> Bool
$c/= :: GetPatchBaselineForPatchGroupResponse
-> GetPatchBaselineForPatchGroupResponse -> Bool
== :: GetPatchBaselineForPatchGroupResponse
-> GetPatchBaselineForPatchGroupResponse -> Bool
$c== :: GetPatchBaselineForPatchGroupResponse
-> GetPatchBaselineForPatchGroupResponse -> Bool
Prelude.Eq, ReadPrec [GetPatchBaselineForPatchGroupResponse]
ReadPrec GetPatchBaselineForPatchGroupResponse
Int -> ReadS GetPatchBaselineForPatchGroupResponse
ReadS [GetPatchBaselineForPatchGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPatchBaselineForPatchGroupResponse]
$creadListPrec :: ReadPrec [GetPatchBaselineForPatchGroupResponse]
readPrec :: ReadPrec GetPatchBaselineForPatchGroupResponse
$creadPrec :: ReadPrec GetPatchBaselineForPatchGroupResponse
readList :: ReadS [GetPatchBaselineForPatchGroupResponse]
$creadList :: ReadS [GetPatchBaselineForPatchGroupResponse]
readsPrec :: Int -> ReadS GetPatchBaselineForPatchGroupResponse
$creadsPrec :: Int -> ReadS GetPatchBaselineForPatchGroupResponse
Prelude.Read, Int -> GetPatchBaselineForPatchGroupResponse -> ShowS
[GetPatchBaselineForPatchGroupResponse] -> ShowS
GetPatchBaselineForPatchGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPatchBaselineForPatchGroupResponse] -> ShowS
$cshowList :: [GetPatchBaselineForPatchGroupResponse] -> ShowS
show :: GetPatchBaselineForPatchGroupResponse -> String
$cshow :: GetPatchBaselineForPatchGroupResponse -> String
showsPrec :: Int -> GetPatchBaselineForPatchGroupResponse -> ShowS
$cshowsPrec :: Int -> GetPatchBaselineForPatchGroupResponse -> ShowS
Prelude.Show, forall x.
Rep GetPatchBaselineForPatchGroupResponse x
-> GetPatchBaselineForPatchGroupResponse
forall x.
GetPatchBaselineForPatchGroupResponse
-> Rep GetPatchBaselineForPatchGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPatchBaselineForPatchGroupResponse x
-> GetPatchBaselineForPatchGroupResponse
$cfrom :: forall x.
GetPatchBaselineForPatchGroupResponse
-> Rep GetPatchBaselineForPatchGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPatchBaselineForPatchGroupResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'baselineId', 'getPatchBaselineForPatchGroupResponse_baselineId' - The ID of the patch baseline that should be used for the patch group.
--
-- 'operatingSystem', 'getPatchBaselineForPatchGroupResponse_operatingSystem' - The operating system rule specified for patch groups using the patch
-- baseline.
--
-- 'patchGroup', 'getPatchBaselineForPatchGroupResponse_patchGroup' - The name of the patch group.
--
-- 'httpStatus', 'getPatchBaselineForPatchGroupResponse_httpStatus' - The response's http status code.
newGetPatchBaselineForPatchGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPatchBaselineForPatchGroupResponse
newGetPatchBaselineForPatchGroupResponse :: Int -> GetPatchBaselineForPatchGroupResponse
newGetPatchBaselineForPatchGroupResponse Int
pHttpStatus_ =
  GetPatchBaselineForPatchGroupResponse'
    { $sel:baselineId:GetPatchBaselineForPatchGroupResponse' :: Maybe Text
baselineId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:GetPatchBaselineForPatchGroupResponse' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:patchGroup:GetPatchBaselineForPatchGroupResponse' :: Maybe Text
patchGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPatchBaselineForPatchGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the patch baseline that should be used for the patch group.
getPatchBaselineForPatchGroupResponse_baselineId :: Lens.Lens' GetPatchBaselineForPatchGroupResponse (Prelude.Maybe Prelude.Text)
getPatchBaselineForPatchGroupResponse_baselineId :: Lens' GetPatchBaselineForPatchGroupResponse (Maybe Text)
getPatchBaselineForPatchGroupResponse_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPatchBaselineForPatchGroupResponse' {Maybe Text
baselineId :: Maybe Text
$sel:baselineId:GetPatchBaselineForPatchGroupResponse' :: GetPatchBaselineForPatchGroupResponse -> Maybe Text
baselineId} -> Maybe Text
baselineId) (\s :: GetPatchBaselineForPatchGroupResponse
s@GetPatchBaselineForPatchGroupResponse' {} Maybe Text
a -> GetPatchBaselineForPatchGroupResponse
s {$sel:baselineId:GetPatchBaselineForPatchGroupResponse' :: Maybe Text
baselineId = Maybe Text
a} :: GetPatchBaselineForPatchGroupResponse)

-- | The operating system rule specified for patch groups using the patch
-- baseline.
getPatchBaselineForPatchGroupResponse_operatingSystem :: Lens.Lens' GetPatchBaselineForPatchGroupResponse (Prelude.Maybe OperatingSystem)
getPatchBaselineForPatchGroupResponse_operatingSystem :: Lens' GetPatchBaselineForPatchGroupResponse (Maybe OperatingSystem)
getPatchBaselineForPatchGroupResponse_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPatchBaselineForPatchGroupResponse' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetPatchBaselineForPatchGroupResponse' :: GetPatchBaselineForPatchGroupResponse -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: GetPatchBaselineForPatchGroupResponse
s@GetPatchBaselineForPatchGroupResponse' {} Maybe OperatingSystem
a -> GetPatchBaselineForPatchGroupResponse
s {$sel:operatingSystem:GetPatchBaselineForPatchGroupResponse' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: GetPatchBaselineForPatchGroupResponse)

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

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

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