{-# 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.DescribePatchProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the properties of available patches organized by product, product
-- family, classification, severity, and other properties of available
-- patches. You can use the reported properties in the filters you specify
-- in requests for operations such as CreatePatchBaseline,
-- UpdatePatchBaseline, DescribeAvailablePatches, and
-- DescribePatchBaselines.
--
-- The following section lists the properties that can be used in filters
-- for each major operating system type:
--
-- [AMAZON_LINUX]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [AMAZON_LINUX_2]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [CENTOS]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [DEBIAN]
--     Valid properties: @PRODUCT@ | @PRIORITY@
--
-- [MACOS]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@
--
-- [ORACLE_LINUX]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [REDHAT_ENTERPRISE_LINUX]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [SUSE]
--     Valid properties: @PRODUCT@ | @CLASSIFICATION@ | @SEVERITY@
--
-- [UBUNTU]
--     Valid properties: @PRODUCT@ | @PRIORITY@
--
-- [WINDOWS]
--     Valid properties: @PRODUCT@ | @PRODUCT_FAMILY@ | @CLASSIFICATION@ |
--     @MSRC_SEVERITY@
--
-- This operation returns paginated results.
module Amazonka.SSM.DescribePatchProperties
  ( -- * Creating a Request
    DescribePatchProperties (..),
    newDescribePatchProperties,

    -- * Request Lenses
    describePatchProperties_maxResults,
    describePatchProperties_nextToken,
    describePatchProperties_patchSet,
    describePatchProperties_operatingSystem,
    describePatchProperties_property,

    -- * Destructuring the Response
    DescribePatchPropertiesResponse (..),
    newDescribePatchPropertiesResponse,

    -- * Response Lenses
    describePatchPropertiesResponse_nextToken,
    describePatchPropertiesResponse_properties,
    describePatchPropertiesResponse_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:/ 'newDescribePatchProperties' smart constructor.
data DescribePatchProperties = DescribePatchProperties'
  { -- | The maximum number of items to return for this call. The call also
    -- returns a token that you can specify in a subsequent call to get the
    -- next set of results.
    DescribePatchProperties -> 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.)
    DescribePatchProperties -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to list patches for the Windows operating system or
    -- for applications released by Microsoft. Not applicable for the Linux or
    -- macOS operating systems.
    DescribePatchProperties -> Maybe PatchSet
patchSet :: Prelude.Maybe PatchSet,
    -- | The operating system type for which to list patches.
    DescribePatchProperties -> OperatingSystem
operatingSystem :: OperatingSystem,
    -- | The patch property for which you want to view patch details.
    DescribePatchProperties -> PatchProperty
property :: PatchProperty
  }
  deriving (DescribePatchProperties -> DescribePatchProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePatchProperties -> DescribePatchProperties -> Bool
$c/= :: DescribePatchProperties -> DescribePatchProperties -> Bool
== :: DescribePatchProperties -> DescribePatchProperties -> Bool
$c== :: DescribePatchProperties -> DescribePatchProperties -> Bool
Prelude.Eq, ReadPrec [DescribePatchProperties]
ReadPrec DescribePatchProperties
Int -> ReadS DescribePatchProperties
ReadS [DescribePatchProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePatchProperties]
$creadListPrec :: ReadPrec [DescribePatchProperties]
readPrec :: ReadPrec DescribePatchProperties
$creadPrec :: ReadPrec DescribePatchProperties
readList :: ReadS [DescribePatchProperties]
$creadList :: ReadS [DescribePatchProperties]
readsPrec :: Int -> ReadS DescribePatchProperties
$creadsPrec :: Int -> ReadS DescribePatchProperties
Prelude.Read, Int -> DescribePatchProperties -> ShowS
[DescribePatchProperties] -> ShowS
DescribePatchProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePatchProperties] -> ShowS
$cshowList :: [DescribePatchProperties] -> ShowS
show :: DescribePatchProperties -> String
$cshow :: DescribePatchProperties -> String
showsPrec :: Int -> DescribePatchProperties -> ShowS
$cshowsPrec :: Int -> DescribePatchProperties -> ShowS
Prelude.Show, forall x. Rep DescribePatchProperties x -> DescribePatchProperties
forall x. DescribePatchProperties -> Rep DescribePatchProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePatchProperties x -> DescribePatchProperties
$cfrom :: forall x. DescribePatchProperties -> Rep DescribePatchProperties x
Prelude.Generic)

-- |
-- Create a value of 'DescribePatchProperties' 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', 'describePatchProperties_maxResults' - The maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
--
-- 'nextToken', 'describePatchProperties_nextToken' - The token for the next set of items to return. (You received this token
-- from a previous call.)
--
-- 'patchSet', 'describePatchProperties_patchSet' - Indicates whether to list patches for the Windows operating system or
-- for applications released by Microsoft. Not applicable for the Linux or
-- macOS operating systems.
--
-- 'operatingSystem', 'describePatchProperties_operatingSystem' - The operating system type for which to list patches.
--
-- 'property', 'describePatchProperties_property' - The patch property for which you want to view patch details.
newDescribePatchProperties ::
  -- | 'operatingSystem'
  OperatingSystem ->
  -- | 'property'
  PatchProperty ->
  DescribePatchProperties
newDescribePatchProperties :: OperatingSystem -> PatchProperty -> DescribePatchProperties
newDescribePatchProperties
  OperatingSystem
pOperatingSystem_
  PatchProperty
pProperty_ =
    DescribePatchProperties'
      { $sel:maxResults:DescribePatchProperties' :: Maybe Natural
maxResults =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribePatchProperties' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:patchSet:DescribePatchProperties' :: Maybe PatchSet
patchSet = forall a. Maybe a
Prelude.Nothing,
        $sel:operatingSystem:DescribePatchProperties' :: OperatingSystem
operatingSystem = OperatingSystem
pOperatingSystem_,
        $sel:property:DescribePatchProperties' :: PatchProperty
property = PatchProperty
pProperty_
      }

-- | The maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
describePatchProperties_maxResults :: Lens.Lens' DescribePatchProperties (Prelude.Maybe Prelude.Natural)
describePatchProperties_maxResults :: Lens' DescribePatchProperties (Maybe Natural)
describePatchProperties_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePatchProperties' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribePatchProperties' :: DescribePatchProperties -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribePatchProperties
s@DescribePatchProperties' {} Maybe Natural
a -> DescribePatchProperties
s {$sel:maxResults:DescribePatchProperties' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribePatchProperties)

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

-- | Indicates whether to list patches for the Windows operating system or
-- for applications released by Microsoft. Not applicable for the Linux or
-- macOS operating systems.
describePatchProperties_patchSet :: Lens.Lens' DescribePatchProperties (Prelude.Maybe PatchSet)
describePatchProperties_patchSet :: Lens' DescribePatchProperties (Maybe PatchSet)
describePatchProperties_patchSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePatchProperties' {Maybe PatchSet
patchSet :: Maybe PatchSet
$sel:patchSet:DescribePatchProperties' :: DescribePatchProperties -> Maybe PatchSet
patchSet} -> Maybe PatchSet
patchSet) (\s :: DescribePatchProperties
s@DescribePatchProperties' {} Maybe PatchSet
a -> DescribePatchProperties
s {$sel:patchSet:DescribePatchProperties' :: Maybe PatchSet
patchSet = Maybe PatchSet
a} :: DescribePatchProperties)

-- | The operating system type for which to list patches.
describePatchProperties_operatingSystem :: Lens.Lens' DescribePatchProperties OperatingSystem
describePatchProperties_operatingSystem :: Lens' DescribePatchProperties OperatingSystem
describePatchProperties_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePatchProperties' {OperatingSystem
operatingSystem :: OperatingSystem
$sel:operatingSystem:DescribePatchProperties' :: DescribePatchProperties -> OperatingSystem
operatingSystem} -> OperatingSystem
operatingSystem) (\s :: DescribePatchProperties
s@DescribePatchProperties' {} OperatingSystem
a -> DescribePatchProperties
s {$sel:operatingSystem:DescribePatchProperties' :: OperatingSystem
operatingSystem = OperatingSystem
a} :: DescribePatchProperties)

-- | The patch property for which you want to view patch details.
describePatchProperties_property :: Lens.Lens' DescribePatchProperties PatchProperty
describePatchProperties_property :: Lens' DescribePatchProperties PatchProperty
describePatchProperties_property = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePatchProperties' {PatchProperty
property :: PatchProperty
$sel:property:DescribePatchProperties' :: DescribePatchProperties -> PatchProperty
property} -> PatchProperty
property) (\s :: DescribePatchProperties
s@DescribePatchProperties' {} PatchProperty
a -> DescribePatchProperties
s {$sel:property:DescribePatchProperties' :: PatchProperty
property = PatchProperty
a} :: DescribePatchProperties)

instance Core.AWSPager DescribePatchProperties where
  page :: DescribePatchProperties
-> AWSResponse DescribePatchProperties
-> Maybe DescribePatchProperties
page DescribePatchProperties
rq AWSResponse DescribePatchProperties
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribePatchProperties
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePatchPropertiesResponse (Maybe Text)
describePatchPropertiesResponse_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 DescribePatchProperties
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePatchPropertiesResponse (Maybe [HashMap Text Text])
describePatchPropertiesResponse_properties
            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.$ DescribePatchProperties
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribePatchProperties (Maybe Text)
describePatchProperties_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribePatchProperties
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePatchPropertiesResponse (Maybe Text)
describePatchPropertiesResponse_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 DescribePatchProperties where
  type
    AWSResponse DescribePatchProperties =
      DescribePatchPropertiesResponse
  request :: (Service -> Service)
-> DescribePatchProperties -> Request DescribePatchProperties
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 DescribePatchProperties
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribePatchProperties)))
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 [HashMap Text Text]
-> Int
-> DescribePatchPropertiesResponse
DescribePatchPropertiesResponse'
            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
"NextToken")
            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
"Properties" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribePatchProperties where
  hashWithSalt :: Int -> DescribePatchProperties -> Int
hashWithSalt Int
_salt DescribePatchProperties' {Maybe Natural
Maybe Text
Maybe PatchSet
OperatingSystem
PatchProperty
property :: PatchProperty
operatingSystem :: OperatingSystem
patchSet :: Maybe PatchSet
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:property:DescribePatchProperties' :: DescribePatchProperties -> PatchProperty
$sel:operatingSystem:DescribePatchProperties' :: DescribePatchProperties -> OperatingSystem
$sel:patchSet:DescribePatchProperties' :: DescribePatchProperties -> Maybe PatchSet
$sel:nextToken:DescribePatchProperties' :: DescribePatchProperties -> Maybe Text
$sel:maxResults:DescribePatchProperties' :: DescribePatchProperties -> 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` Maybe PatchSet
patchSet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OperatingSystem
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PatchProperty
property

instance Prelude.NFData DescribePatchProperties where
  rnf :: DescribePatchProperties -> ()
rnf DescribePatchProperties' {Maybe Natural
Maybe Text
Maybe PatchSet
OperatingSystem
PatchProperty
property :: PatchProperty
operatingSystem :: OperatingSystem
patchSet :: Maybe PatchSet
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:property:DescribePatchProperties' :: DescribePatchProperties -> PatchProperty
$sel:operatingSystem:DescribePatchProperties' :: DescribePatchProperties -> OperatingSystem
$sel:patchSet:DescribePatchProperties' :: DescribePatchProperties -> Maybe PatchSet
$sel:nextToken:DescribePatchProperties' :: DescribePatchProperties -> Maybe Text
$sel:maxResults:DescribePatchProperties' :: DescribePatchProperties -> 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 Maybe PatchSet
patchSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OperatingSystem
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PatchProperty
property

instance Data.ToHeaders DescribePatchProperties where
  toHeaders :: DescribePatchProperties -> 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.DescribePatchProperties" ::
                          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 DescribePatchProperties where
  toJSON :: DescribePatchProperties -> Value
toJSON DescribePatchProperties' {Maybe Natural
Maybe Text
Maybe PatchSet
OperatingSystem
PatchProperty
property :: PatchProperty
operatingSystem :: OperatingSystem
patchSet :: Maybe PatchSet
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:property:DescribePatchProperties' :: DescribePatchProperties -> PatchProperty
$sel:operatingSystem:DescribePatchProperties' :: DescribePatchProperties -> OperatingSystem
$sel:patchSet:DescribePatchProperties' :: DescribePatchProperties -> Maybe PatchSet
$sel:nextToken:DescribePatchProperties' :: DescribePatchProperties -> Maybe Text
$sel:maxResults:DescribePatchProperties' :: DescribePatchProperties -> 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,
            (Key
"PatchSet" 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 PatchSet
patchSet,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OperatingSystem" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OperatingSystem
operatingSystem),
            forall a. a -> Maybe a
Prelude.Just (Key
"Property" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PatchProperty
property)
          ]
      )

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

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

-- | /See:/ 'newDescribePatchPropertiesResponse' smart constructor.
data DescribePatchPropertiesResponse = DescribePatchPropertiesResponse'
  { -- | The token for the next set of items to return. (You use this token in
    -- the next call.)
    DescribePatchPropertiesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of the properties for patches matching the filter request
    -- parameters.
    DescribePatchPropertiesResponse -> Maybe [HashMap Text Text]
properties :: Prelude.Maybe [Prelude.HashMap Prelude.Text Prelude.Text],
    -- | The response's http status code.
    DescribePatchPropertiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePatchPropertiesResponse
-> DescribePatchPropertiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePatchPropertiesResponse
-> DescribePatchPropertiesResponse -> Bool
$c/= :: DescribePatchPropertiesResponse
-> DescribePatchPropertiesResponse -> Bool
== :: DescribePatchPropertiesResponse
-> DescribePatchPropertiesResponse -> Bool
$c== :: DescribePatchPropertiesResponse
-> DescribePatchPropertiesResponse -> Bool
Prelude.Eq, ReadPrec [DescribePatchPropertiesResponse]
ReadPrec DescribePatchPropertiesResponse
Int -> ReadS DescribePatchPropertiesResponse
ReadS [DescribePatchPropertiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePatchPropertiesResponse]
$creadListPrec :: ReadPrec [DescribePatchPropertiesResponse]
readPrec :: ReadPrec DescribePatchPropertiesResponse
$creadPrec :: ReadPrec DescribePatchPropertiesResponse
readList :: ReadS [DescribePatchPropertiesResponse]
$creadList :: ReadS [DescribePatchPropertiesResponse]
readsPrec :: Int -> ReadS DescribePatchPropertiesResponse
$creadsPrec :: Int -> ReadS DescribePatchPropertiesResponse
Prelude.Read, Int -> DescribePatchPropertiesResponse -> ShowS
[DescribePatchPropertiesResponse] -> ShowS
DescribePatchPropertiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePatchPropertiesResponse] -> ShowS
$cshowList :: [DescribePatchPropertiesResponse] -> ShowS
show :: DescribePatchPropertiesResponse -> String
$cshow :: DescribePatchPropertiesResponse -> String
showsPrec :: Int -> DescribePatchPropertiesResponse -> ShowS
$cshowsPrec :: Int -> DescribePatchPropertiesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribePatchPropertiesResponse x
-> DescribePatchPropertiesResponse
forall x.
DescribePatchPropertiesResponse
-> Rep DescribePatchPropertiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePatchPropertiesResponse x
-> DescribePatchPropertiesResponse
$cfrom :: forall x.
DescribePatchPropertiesResponse
-> Rep DescribePatchPropertiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePatchPropertiesResponse' 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:
--
-- 'nextToken', 'describePatchPropertiesResponse_nextToken' - The token for the next set of items to return. (You use this token in
-- the next call.)
--
-- 'properties', 'describePatchPropertiesResponse_properties' - A list of the properties for patches matching the filter request
-- parameters.
--
-- 'httpStatus', 'describePatchPropertiesResponse_httpStatus' - The response's http status code.
newDescribePatchPropertiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePatchPropertiesResponse
newDescribePatchPropertiesResponse :: Int -> DescribePatchPropertiesResponse
newDescribePatchPropertiesResponse Int
pHttpStatus_ =
  DescribePatchPropertiesResponse'
    { $sel:nextToken:DescribePatchPropertiesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:properties:DescribePatchPropertiesResponse' :: Maybe [HashMap Text Text]
properties = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePatchPropertiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A list of the properties for patches matching the filter request
-- parameters.
describePatchPropertiesResponse_properties :: Lens.Lens' DescribePatchPropertiesResponse (Prelude.Maybe [Prelude.HashMap Prelude.Text Prelude.Text])
describePatchPropertiesResponse_properties :: Lens' DescribePatchPropertiesResponse (Maybe [HashMap Text Text])
describePatchPropertiesResponse_properties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePatchPropertiesResponse' {Maybe [HashMap Text Text]
properties :: Maybe [HashMap Text Text]
$sel:properties:DescribePatchPropertiesResponse' :: DescribePatchPropertiesResponse -> Maybe [HashMap Text Text]
properties} -> Maybe [HashMap Text Text]
properties) (\s :: DescribePatchPropertiesResponse
s@DescribePatchPropertiesResponse' {} Maybe [HashMap Text Text]
a -> DescribePatchPropertiesResponse
s {$sel:properties:DescribePatchPropertiesResponse' :: Maybe [HashMap Text Text]
properties = Maybe [HashMap Text Text]
a} :: DescribePatchPropertiesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    DescribePatchPropertiesResponse
  where
  rnf :: DescribePatchPropertiesResponse -> ()
rnf DescribePatchPropertiesResponse' {Int
Maybe [HashMap Text Text]
Maybe Text
httpStatus :: Int
properties :: Maybe [HashMap Text Text]
nextToken :: Maybe Text
$sel:httpStatus:DescribePatchPropertiesResponse' :: DescribePatchPropertiesResponse -> Int
$sel:properties:DescribePatchPropertiesResponse' :: DescribePatchPropertiesResponse -> Maybe [HashMap Text Text]
$sel:nextToken:DescribePatchPropertiesResponse' :: DescribePatchPropertiesResponse -> Maybe Text
..} =
    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 Maybe [HashMap Text Text]
properties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus