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

    -- * Request Lenses
    deregisterPatchBaselineForPatchGroup_baselineId,
    deregisterPatchBaselineForPatchGroup_patchGroup,

    -- * Destructuring the Response
    DeregisterPatchBaselineForPatchGroupResponse (..),
    newDeregisterPatchBaselineForPatchGroupResponse,

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

-- |
-- Create a value of 'DeregisterPatchBaselineForPatchGroup' 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', 'deregisterPatchBaselineForPatchGroup_baselineId' - The ID of the patch baseline to deregister the patch group from.
--
-- 'patchGroup', 'deregisterPatchBaselineForPatchGroup_patchGroup' - The name of the patch group that should be deregistered from the patch
-- baseline.
newDeregisterPatchBaselineForPatchGroup ::
  -- | 'baselineId'
  Prelude.Text ->
  -- | 'patchGroup'
  Prelude.Text ->
  DeregisterPatchBaselineForPatchGroup
newDeregisterPatchBaselineForPatchGroup :: Text -> Text -> DeregisterPatchBaselineForPatchGroup
newDeregisterPatchBaselineForPatchGroup
  Text
pBaselineId_
  Text
pPatchGroup_ =
    DeregisterPatchBaselineForPatchGroup'
      { $sel:baselineId:DeregisterPatchBaselineForPatchGroup' :: Text
baselineId =
          Text
pBaselineId_,
        $sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: Text
patchGroup = Text
pPatchGroup_
      }

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

-- | The name of the patch group that should be deregistered from the patch
-- baseline.
deregisterPatchBaselineForPatchGroup_patchGroup :: Lens.Lens' DeregisterPatchBaselineForPatchGroup Prelude.Text
deregisterPatchBaselineForPatchGroup_patchGroup :: Lens' DeregisterPatchBaselineForPatchGroup Text
deregisterPatchBaselineForPatchGroup_patchGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeregisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
$sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> Text
patchGroup} -> Text
patchGroup) (\s :: DeregisterPatchBaselineForPatchGroup
s@DeregisterPatchBaselineForPatchGroup' {} Text
a -> DeregisterPatchBaselineForPatchGroup
s {$sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: Text
patchGroup = Text
a} :: DeregisterPatchBaselineForPatchGroup)

instance
  Core.AWSRequest
    DeregisterPatchBaselineForPatchGroup
  where
  type
    AWSResponse DeregisterPatchBaselineForPatchGroup =
      DeregisterPatchBaselineForPatchGroupResponse
  request :: (Service -> Service)
-> DeregisterPatchBaselineForPatchGroup
-> Request DeregisterPatchBaselineForPatchGroup
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 DeregisterPatchBaselineForPatchGroup
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DeregisterPatchBaselineForPatchGroup)))
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
-> DeregisterPatchBaselineForPatchGroupResponse
DeregisterPatchBaselineForPatchGroupResponse'
            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
    DeregisterPatchBaselineForPatchGroup
  where
  hashWithSalt :: Int -> DeregisterPatchBaselineForPatchGroup -> Int
hashWithSalt
    Int
_salt
    DeregisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
baselineId :: Text
$sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> Text
$sel:baselineId:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> 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
    DeregisterPatchBaselineForPatchGroup
  where
  rnf :: DeregisterPatchBaselineForPatchGroup -> ()
rnf DeregisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
baselineId :: Text
$sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> Text
$sel:baselineId:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> 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
    DeregisterPatchBaselineForPatchGroup
  where
  toHeaders :: DeregisterPatchBaselineForPatchGroup -> 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.DeregisterPatchBaselineForPatchGroup" ::
                          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
    DeregisterPatchBaselineForPatchGroup
  where
  toJSON :: DeregisterPatchBaselineForPatchGroup -> Value
toJSON DeregisterPatchBaselineForPatchGroup' {Text
patchGroup :: Text
baselineId :: Text
$sel:patchGroup:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> Text
$sel:baselineId:DeregisterPatchBaselineForPatchGroup' :: DeregisterPatchBaselineForPatchGroup -> 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
    DeregisterPatchBaselineForPatchGroup
  where
  toPath :: DeregisterPatchBaselineForPatchGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DeregisterPatchBaselineForPatchGroupResponse' 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', 'deregisterPatchBaselineForPatchGroupResponse_baselineId' - The ID of the patch baseline the patch group was deregistered from.
--
-- 'patchGroup', 'deregisterPatchBaselineForPatchGroupResponse_patchGroup' - The name of the patch group deregistered from the patch baseline.
--
-- 'httpStatus', 'deregisterPatchBaselineForPatchGroupResponse_httpStatus' - The response's http status code.
newDeregisterPatchBaselineForPatchGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeregisterPatchBaselineForPatchGroupResponse
newDeregisterPatchBaselineForPatchGroupResponse :: Int -> DeregisterPatchBaselineForPatchGroupResponse
newDeregisterPatchBaselineForPatchGroupResponse
  Int
pHttpStatus_ =
    DeregisterPatchBaselineForPatchGroupResponse'
      { $sel:baselineId:DeregisterPatchBaselineForPatchGroupResponse' :: Maybe Text
baselineId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:patchGroup:DeregisterPatchBaselineForPatchGroupResponse' :: Maybe Text
patchGroup = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DeregisterPatchBaselineForPatchGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

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

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

instance
  Prelude.NFData
    DeregisterPatchBaselineForPatchGroupResponse
  where
  rnf :: DeregisterPatchBaselineForPatchGroupResponse -> ()
rnf DeregisterPatchBaselineForPatchGroupResponse' {Int
Maybe Text
httpStatus :: Int
patchGroup :: Maybe Text
baselineId :: Maybe Text
$sel:httpStatus:DeregisterPatchBaselineForPatchGroupResponse' :: DeregisterPatchBaselineForPatchGroupResponse -> Int
$sel:patchGroup:DeregisterPatchBaselineForPatchGroupResponse' :: DeregisterPatchBaselineForPatchGroupResponse -> Maybe Text
$sel:baselineId:DeregisterPatchBaselineForPatchGroupResponse' :: DeregisterPatchBaselineForPatchGroupResponse -> 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