{-# 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.RegisterPatchBaselineForPatchGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers a patch baseline for a patch group.
module Amazonka.SSM.RegisterPatchBaselineForPatchGroup
  ( -- * Creating a Request
    RegisterPatchBaselineForPatchGroup (..),
    newRegisterPatchBaselineForPatchGroup,

    -- * Request Lenses
    registerPatchBaselineForPatchGroup_baselineId,
    registerPatchBaselineForPatchGroup_patchGroup,

    -- * Destructuring the Response
    RegisterPatchBaselineForPatchGroupResponse (..),
    newRegisterPatchBaselineForPatchGroupResponse,

    -- * Response Lenses
    registerPatchBaselineForPatchGroupResponse_baselineId,
    registerPatchBaselineForPatchGroupResponse_patchGroup,
    registerPatchBaselineForPatchGroupResponse_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:/ 'newRegisterPatchBaselineForPatchGroup' smart constructor.
data RegisterPatchBaselineForPatchGroup = RegisterPatchBaselineForPatchGroup'
  { -- | The ID of the patch baseline to register with the patch group.
    RegisterPatchBaselineForPatchGroup -> Text
baselineId :: Prelude.Text,
    -- | The name of the patch group to be registered with the patch baseline.
    RegisterPatchBaselineForPatchGroup -> Text
patchGroup :: Prelude.Text
  }
  deriving (RegisterPatchBaselineForPatchGroup
-> RegisterPatchBaselineForPatchGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterPatchBaselineForPatchGroup
-> RegisterPatchBaselineForPatchGroup -> Bool
$c/= :: RegisterPatchBaselineForPatchGroup
-> RegisterPatchBaselineForPatchGroup -> Bool
== :: RegisterPatchBaselineForPatchGroup
-> RegisterPatchBaselineForPatchGroup -> Bool
$c== :: RegisterPatchBaselineForPatchGroup
-> RegisterPatchBaselineForPatchGroup -> Bool
Prelude.Eq, ReadPrec [RegisterPatchBaselineForPatchGroup]
ReadPrec RegisterPatchBaselineForPatchGroup
Int -> ReadS RegisterPatchBaselineForPatchGroup
ReadS [RegisterPatchBaselineForPatchGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterPatchBaselineForPatchGroup]
$creadListPrec :: ReadPrec [RegisterPatchBaselineForPatchGroup]
readPrec :: ReadPrec RegisterPatchBaselineForPatchGroup
$creadPrec :: ReadPrec RegisterPatchBaselineForPatchGroup
readList :: ReadS [RegisterPatchBaselineForPatchGroup]
$creadList :: ReadS [RegisterPatchBaselineForPatchGroup]
readsPrec :: Int -> ReadS RegisterPatchBaselineForPatchGroup
$creadsPrec :: Int -> ReadS RegisterPatchBaselineForPatchGroup
Prelude.Read, Int -> RegisterPatchBaselineForPatchGroup -> ShowS
[RegisterPatchBaselineForPatchGroup] -> ShowS
RegisterPatchBaselineForPatchGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterPatchBaselineForPatchGroup] -> ShowS
$cshowList :: [RegisterPatchBaselineForPatchGroup] -> ShowS
show :: RegisterPatchBaselineForPatchGroup -> String
$cshow :: RegisterPatchBaselineForPatchGroup -> String
showsPrec :: Int -> RegisterPatchBaselineForPatchGroup -> ShowS
$cshowsPrec :: Int -> RegisterPatchBaselineForPatchGroup -> ShowS
Prelude.Show, forall x.
Rep RegisterPatchBaselineForPatchGroup x
-> RegisterPatchBaselineForPatchGroup
forall x.
RegisterPatchBaselineForPatchGroup
-> Rep RegisterPatchBaselineForPatchGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterPatchBaselineForPatchGroup x
-> RegisterPatchBaselineForPatchGroup
$cfrom :: forall x.
RegisterPatchBaselineForPatchGroup
-> Rep RegisterPatchBaselineForPatchGroup x
Prelude.Generic)

-- |
-- Create a value of 'RegisterPatchBaselineForPatchGroup' 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', 'registerPatchBaselineForPatchGroup_baselineId' - The ID of the patch baseline to register with the patch group.
--
-- 'patchGroup', 'registerPatchBaselineForPatchGroup_patchGroup' - The name of the patch group to be registered with the patch baseline.
newRegisterPatchBaselineForPatchGroup ::
  -- | 'baselineId'
  Prelude.Text ->
  -- | 'patchGroup'
  Prelude.Text ->
  RegisterPatchBaselineForPatchGroup
newRegisterPatchBaselineForPatchGroup :: Text -> Text -> RegisterPatchBaselineForPatchGroup
newRegisterPatchBaselineForPatchGroup
  Text
pBaselineId_
  Text
pPatchGroup_ =
    RegisterPatchBaselineForPatchGroup'
      { $sel:baselineId:RegisterPatchBaselineForPatchGroup' :: Text
baselineId =
          Text
pBaselineId_,
        $sel:patchGroup:RegisterPatchBaselineForPatchGroup' :: Text
patchGroup = Text
pPatchGroup_
      }

-- | The ID of the patch baseline to register with the patch group.
registerPatchBaselineForPatchGroup_baselineId :: Lens.Lens' RegisterPatchBaselineForPatchGroup Prelude.Text
registerPatchBaselineForPatchGroup_baselineId :: Lens' RegisterPatchBaselineForPatchGroup Text
registerPatchBaselineForPatchGroup_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPatchBaselineForPatchGroup' {Text
baselineId :: Text
$sel:baselineId:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
baselineId} -> Text
baselineId) (\s :: RegisterPatchBaselineForPatchGroup
s@RegisterPatchBaselineForPatchGroup' {} Text
a -> RegisterPatchBaselineForPatchGroup
s {$sel:baselineId:RegisterPatchBaselineForPatchGroup' :: Text
baselineId = Text
a} :: RegisterPatchBaselineForPatchGroup)

-- | The name of the patch group to be registered with the patch baseline.
registerPatchBaselineForPatchGroup_patchGroup :: Lens.Lens' RegisterPatchBaselineForPatchGroup Prelude.Text
registerPatchBaselineForPatchGroup_patchGroup :: Lens' RegisterPatchBaselineForPatchGroup Text
registerPatchBaselineForPatchGroup_patchGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
$sel:patchGroup:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
patchGroup} -> Text
patchGroup) (\s :: RegisterPatchBaselineForPatchGroup
s@RegisterPatchBaselineForPatchGroup' {} Text
a -> RegisterPatchBaselineForPatchGroup
s {$sel:patchGroup:RegisterPatchBaselineForPatchGroup' :: Text
patchGroup = Text
a} :: RegisterPatchBaselineForPatchGroup)

instance
  Core.AWSRequest
    RegisterPatchBaselineForPatchGroup
  where
  type
    AWSResponse RegisterPatchBaselineForPatchGroup =
      RegisterPatchBaselineForPatchGroupResponse
  request :: (Service -> Service)
-> RegisterPatchBaselineForPatchGroup
-> Request RegisterPatchBaselineForPatchGroup
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 RegisterPatchBaselineForPatchGroup
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse RegisterPatchBaselineForPatchGroup)))
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 Text -> Int -> RegisterPatchBaselineForPatchGroupResponse
RegisterPatchBaselineForPatchGroupResponse'
            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
"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
    RegisterPatchBaselineForPatchGroup
  where
  hashWithSalt :: Int -> RegisterPatchBaselineForPatchGroup -> Int
hashWithSalt
    Int
_salt
    RegisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
baselineId :: Text
$sel:patchGroup:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
$sel:baselineId:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
baselineId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
patchGroup

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

instance
  Data.ToHeaders
    RegisterPatchBaselineForPatchGroup
  where
  toHeaders :: RegisterPatchBaselineForPatchGroup -> 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.RegisterPatchBaselineForPatchGroup" ::
                          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
    RegisterPatchBaselineForPatchGroup
  where
  toJSON :: RegisterPatchBaselineForPatchGroup -> Value
toJSON RegisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
baselineId :: Text
$sel:patchGroup:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
$sel:baselineId:RegisterPatchBaselineForPatchGroup' :: RegisterPatchBaselineForPatchGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"BaselineId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
baselineId),
            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
    RegisterPatchBaselineForPatchGroup
  where
  toPath :: RegisterPatchBaselineForPatchGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'RegisterPatchBaselineForPatchGroupResponse' 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', 'registerPatchBaselineForPatchGroupResponse_baselineId' - The ID of the patch baseline the patch group was registered with.
--
-- 'patchGroup', 'registerPatchBaselineForPatchGroupResponse_patchGroup' - The name of the patch group registered with the patch baseline.
--
-- 'httpStatus', 'registerPatchBaselineForPatchGroupResponse_httpStatus' - The response's http status code.
newRegisterPatchBaselineForPatchGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterPatchBaselineForPatchGroupResponse
newRegisterPatchBaselineForPatchGroupResponse :: Int -> RegisterPatchBaselineForPatchGroupResponse
newRegisterPatchBaselineForPatchGroupResponse
  Int
pHttpStatus_ =
    RegisterPatchBaselineForPatchGroupResponse'
      { $sel:baselineId:RegisterPatchBaselineForPatchGroupResponse' :: Maybe Text
baselineId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:patchGroup:RegisterPatchBaselineForPatchGroupResponse' :: Maybe Text
patchGroup = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:RegisterPatchBaselineForPatchGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the patch baseline the patch group was registered with.
registerPatchBaselineForPatchGroupResponse_baselineId :: Lens.Lens' RegisterPatchBaselineForPatchGroupResponse (Prelude.Maybe Prelude.Text)
registerPatchBaselineForPatchGroupResponse_baselineId :: Lens' RegisterPatchBaselineForPatchGroupResponse (Maybe Text)
registerPatchBaselineForPatchGroupResponse_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterPatchBaselineForPatchGroupResponse' {Maybe Text
baselineId :: Maybe Text
$sel:baselineId:RegisterPatchBaselineForPatchGroupResponse' :: RegisterPatchBaselineForPatchGroupResponse -> Maybe Text
baselineId} -> Maybe Text
baselineId) (\s :: RegisterPatchBaselineForPatchGroupResponse
s@RegisterPatchBaselineForPatchGroupResponse' {} Maybe Text
a -> RegisterPatchBaselineForPatchGroupResponse
s {$sel:baselineId:RegisterPatchBaselineForPatchGroupResponse' :: Maybe Text
baselineId = Maybe Text
a} :: RegisterPatchBaselineForPatchGroupResponse)

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

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

instance
  Prelude.NFData
    RegisterPatchBaselineForPatchGroupResponse
  where
  rnf :: RegisterPatchBaselineForPatchGroupResponse -> ()
rnf RegisterPatchBaselineForPatchGroupResponse' {Int
Maybe Text
httpStatus :: Int
patchGroup :: Maybe Text
baselineId :: Maybe Text
$sel:httpStatus:RegisterPatchBaselineForPatchGroupResponse' :: RegisterPatchBaselineForPatchGroupResponse -> Int
$sel:patchGroup:RegisterPatchBaselineForPatchGroupResponse' :: RegisterPatchBaselineForPatchGroupResponse -> Maybe Text
$sel:baselineId:RegisterPatchBaselineForPatchGroupResponse' :: RegisterPatchBaselineForPatchGroupResponse -> 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 Text
patchGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus