{-# 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.RDS.DescribeOptionGroups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the available option groups.
--
-- This operation returns paginated results.
module Amazonka.RDS.DescribeOptionGroups
  ( -- * Creating a Request
    DescribeOptionGroups (..),
    newDescribeOptionGroups,

    -- * Request Lenses
    describeOptionGroups_engineName,
    describeOptionGroups_filters,
    describeOptionGroups_majorEngineVersion,
    describeOptionGroups_marker,
    describeOptionGroups_maxRecords,
    describeOptionGroups_optionGroupName,

    -- * Destructuring the Response
    DescribeOptionGroupsResponse (..),
    newDescribeOptionGroupsResponse,

    -- * Response Lenses
    describeOptionGroupsResponse_marker,
    describeOptionGroupsResponse_optionGroupsList,
    describeOptionGroupsResponse_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 Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDescribeOptionGroups' smart constructor.
data DescribeOptionGroups = DescribeOptionGroups'
  { -- | Filters the list of option groups to only include groups associated with
    -- a specific database engine.
    --
    -- Valid Values:
    --
    -- -   @mariadb@
    --
    -- -   @mysql@
    --
    -- -   @oracle-ee@
    --
    -- -   @oracle-ee-cdb@
    --
    -- -   @oracle-se2@
    --
    -- -   @oracle-se2-cdb@
    --
    -- -   @postgres@
    --
    -- -   @sqlserver-ee@
    --
    -- -   @sqlserver-se@
    --
    -- -   @sqlserver-ex@
    --
    -- -   @sqlserver-web@
    DescribeOptionGroups -> Maybe Text
engineName :: Prelude.Maybe Prelude.Text,
    -- | This parameter isn\'t currently supported.
    DescribeOptionGroups -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | Filters the list of option groups to only include groups associated with
    -- a specific database engine version. If specified, then EngineName must
    -- also be specified.
    DescribeOptionGroups -> Maybe Text
majorEngineVersion :: Prelude.Maybe Prelude.Text,
    -- | An optional pagination token provided by a previous DescribeOptionGroups
    -- request. If this parameter is specified, the response includes only
    -- records beyond the marker, up to the value specified by @MaxRecords@.
    DescribeOptionGroups -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of records to include in the response. If more
    -- records exist than the specified @MaxRecords@ value, a pagination token
    -- called a marker is included in the response so that you can retrieve the
    -- remaining results.
    --
    -- Default: 100
    --
    -- Constraints: Minimum 20, maximum 100.
    DescribeOptionGroups -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The name of the option group to describe. Can\'t be supplied together
    -- with EngineName or MajorEngineVersion.
    DescribeOptionGroups -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeOptionGroups -> DescribeOptionGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeOptionGroups -> DescribeOptionGroups -> Bool
$c/= :: DescribeOptionGroups -> DescribeOptionGroups -> Bool
== :: DescribeOptionGroups -> DescribeOptionGroups -> Bool
$c== :: DescribeOptionGroups -> DescribeOptionGroups -> Bool
Prelude.Eq, ReadPrec [DescribeOptionGroups]
ReadPrec DescribeOptionGroups
Int -> ReadS DescribeOptionGroups
ReadS [DescribeOptionGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeOptionGroups]
$creadListPrec :: ReadPrec [DescribeOptionGroups]
readPrec :: ReadPrec DescribeOptionGroups
$creadPrec :: ReadPrec DescribeOptionGroups
readList :: ReadS [DescribeOptionGroups]
$creadList :: ReadS [DescribeOptionGroups]
readsPrec :: Int -> ReadS DescribeOptionGroups
$creadsPrec :: Int -> ReadS DescribeOptionGroups
Prelude.Read, Int -> DescribeOptionGroups -> ShowS
[DescribeOptionGroups] -> ShowS
DescribeOptionGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeOptionGroups] -> ShowS
$cshowList :: [DescribeOptionGroups] -> ShowS
show :: DescribeOptionGroups -> String
$cshow :: DescribeOptionGroups -> String
showsPrec :: Int -> DescribeOptionGroups -> ShowS
$cshowsPrec :: Int -> DescribeOptionGroups -> ShowS
Prelude.Show, forall x. Rep DescribeOptionGroups x -> DescribeOptionGroups
forall x. DescribeOptionGroups -> Rep DescribeOptionGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeOptionGroups x -> DescribeOptionGroups
$cfrom :: forall x. DescribeOptionGroups -> Rep DescribeOptionGroups x
Prelude.Generic)

-- |
-- Create a value of 'DescribeOptionGroups' 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:
--
-- 'engineName', 'describeOptionGroups_engineName' - Filters the list of option groups to only include groups associated with
-- a specific database engine.
--
-- Valid Values:
--
-- -   @mariadb@
--
-- -   @mysql@
--
-- -   @oracle-ee@
--
-- -   @oracle-ee-cdb@
--
-- -   @oracle-se2@
--
-- -   @oracle-se2-cdb@
--
-- -   @postgres@
--
-- -   @sqlserver-ee@
--
-- -   @sqlserver-se@
--
-- -   @sqlserver-ex@
--
-- -   @sqlserver-web@
--
-- 'filters', 'describeOptionGroups_filters' - This parameter isn\'t currently supported.
--
-- 'majorEngineVersion', 'describeOptionGroups_majorEngineVersion' - Filters the list of option groups to only include groups associated with
-- a specific database engine version. If specified, then EngineName must
-- also be specified.
--
-- 'marker', 'describeOptionGroups_marker' - An optional pagination token provided by a previous DescribeOptionGroups
-- request. If this parameter is specified, the response includes only
-- records beyond the marker, up to the value specified by @MaxRecords@.
--
-- 'maxRecords', 'describeOptionGroups_maxRecords' - The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- called a marker is included in the response so that you can retrieve the
-- remaining results.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
--
-- 'optionGroupName', 'describeOptionGroups_optionGroupName' - The name of the option group to describe. Can\'t be supplied together
-- with EngineName or MajorEngineVersion.
newDescribeOptionGroups ::
  DescribeOptionGroups
newDescribeOptionGroups :: DescribeOptionGroups
newDescribeOptionGroups =
  DescribeOptionGroups'
    { $sel:engineName:DescribeOptionGroups' :: Maybe Text
engineName = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeOptionGroups' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:majorEngineVersion:DescribeOptionGroups' :: Maybe Text
majorEngineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeOptionGroups' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeOptionGroups' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:optionGroupName:DescribeOptionGroups' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing
    }

-- | Filters the list of option groups to only include groups associated with
-- a specific database engine.
--
-- Valid Values:
--
-- -   @mariadb@
--
-- -   @mysql@
--
-- -   @oracle-ee@
--
-- -   @oracle-ee-cdb@
--
-- -   @oracle-se2@
--
-- -   @oracle-se2-cdb@
--
-- -   @postgres@
--
-- -   @sqlserver-ee@
--
-- -   @sqlserver-se@
--
-- -   @sqlserver-ex@
--
-- -   @sqlserver-web@
describeOptionGroups_engineName :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe Prelude.Text)
describeOptionGroups_engineName :: Lens' DescribeOptionGroups (Maybe Text)
describeOptionGroups_engineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe Text
engineName :: Maybe Text
$sel:engineName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
engineName} -> Maybe Text
engineName) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe Text
a -> DescribeOptionGroups
s {$sel:engineName:DescribeOptionGroups' :: Maybe Text
engineName = Maybe Text
a} :: DescribeOptionGroups)

-- | This parameter isn\'t currently supported.
describeOptionGroups_filters :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe [Filter])
describeOptionGroups_filters :: Lens' DescribeOptionGroups (Maybe [Filter])
describeOptionGroups_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe [Filter]
a -> DescribeOptionGroups
s {$sel:filters:DescribeOptionGroups' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeOptionGroups) 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

-- | Filters the list of option groups to only include groups associated with
-- a specific database engine version. If specified, then EngineName must
-- also be specified.
describeOptionGroups_majorEngineVersion :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe Prelude.Text)
describeOptionGroups_majorEngineVersion :: Lens' DescribeOptionGroups (Maybe Text)
describeOptionGroups_majorEngineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe Text
majorEngineVersion :: Maybe Text
$sel:majorEngineVersion:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
majorEngineVersion} -> Maybe Text
majorEngineVersion) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe Text
a -> DescribeOptionGroups
s {$sel:majorEngineVersion:DescribeOptionGroups' :: Maybe Text
majorEngineVersion = Maybe Text
a} :: DescribeOptionGroups)

-- | An optional pagination token provided by a previous DescribeOptionGroups
-- request. If this parameter is specified, the response includes only
-- records beyond the marker, up to the value specified by @MaxRecords@.
describeOptionGroups_marker :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe Prelude.Text)
describeOptionGroups_marker :: Lens' DescribeOptionGroups (Maybe Text)
describeOptionGroups_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe Text
a -> DescribeOptionGroups
s {$sel:marker:DescribeOptionGroups' :: Maybe Text
marker = Maybe Text
a} :: DescribeOptionGroups)

-- | The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- called a marker is included in the response so that you can retrieve the
-- remaining results.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
describeOptionGroups_maxRecords :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe Prelude.Int)
describeOptionGroups_maxRecords :: Lens' DescribeOptionGroups (Maybe Int)
describeOptionGroups_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe Int
a -> DescribeOptionGroups
s {$sel:maxRecords:DescribeOptionGroups' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeOptionGroups)

-- | The name of the option group to describe. Can\'t be supplied together
-- with EngineName or MajorEngineVersion.
describeOptionGroups_optionGroupName :: Lens.Lens' DescribeOptionGroups (Prelude.Maybe Prelude.Text)
describeOptionGroups_optionGroupName :: Lens' DescribeOptionGroups (Maybe Text)
describeOptionGroups_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroups' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: DescribeOptionGroups
s@DescribeOptionGroups' {} Maybe Text
a -> DescribeOptionGroups
s {$sel:optionGroupName:DescribeOptionGroups' :: Maybe Text
optionGroupName = Maybe Text
a} :: DescribeOptionGroups)

instance Core.AWSPager DescribeOptionGroups where
  page :: DescribeOptionGroups
-> AWSResponse DescribeOptionGroups -> Maybe DescribeOptionGroups
page DescribeOptionGroups
rq AWSResponse DescribeOptionGroups
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeOptionGroups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeOptionGroupsResponse (Maybe Text)
describeOptionGroupsResponse_marker
            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 DescribeOptionGroups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeOptionGroupsResponse (Maybe [OptionGroup])
describeOptionGroupsResponse_optionGroupsList
            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.$ DescribeOptionGroups
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeOptionGroups (Maybe Text)
describeOptionGroups_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeOptionGroups
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeOptionGroupsResponse (Maybe Text)
describeOptionGroupsResponse_marker
          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 DescribeOptionGroups where
  type
    AWSResponse DescribeOptionGroups =
      DescribeOptionGroupsResponse
  request :: (Service -> Service)
-> DescribeOptionGroups -> Request DescribeOptionGroups
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeOptionGroups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeOptionGroups)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DescribeOptionGroupsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [OptionGroup] -> Int -> DescribeOptionGroupsResponse
DescribeOptionGroupsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"OptionGroupsList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"OptionGroup")
                        )
            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 DescribeOptionGroups where
  hashWithSalt :: Int -> DescribeOptionGroups -> Int
hashWithSalt Int
_salt DescribeOptionGroups' {Maybe Int
Maybe [Filter]
Maybe Text
optionGroupName :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
majorEngineVersion :: Maybe Text
filters :: Maybe [Filter]
engineName :: Maybe Text
$sel:optionGroupName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:maxRecords:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Int
$sel:marker:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:majorEngineVersion:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:filters:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe [Filter]
$sel:engineName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
majorEngineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxRecords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName

instance Prelude.NFData DescribeOptionGroups where
  rnf :: DescribeOptionGroups -> ()
rnf DescribeOptionGroups' {Maybe Int
Maybe [Filter]
Maybe Text
optionGroupName :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
majorEngineVersion :: Maybe Text
filters :: Maybe [Filter]
engineName :: Maybe Text
$sel:optionGroupName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:maxRecords:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Int
$sel:marker:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:majorEngineVersion:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:filters:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe [Filter]
$sel:engineName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
majorEngineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionGroupName

instance Data.ToHeaders DescribeOptionGroups where
  toHeaders :: DescribeOptionGroups -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeOptionGroups where
  toQuery :: DescribeOptionGroups -> QueryString
toQuery DescribeOptionGroups' {Maybe Int
Maybe [Filter]
Maybe Text
optionGroupName :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
majorEngineVersion :: Maybe Text
filters :: Maybe [Filter]
engineName :: Maybe Text
$sel:optionGroupName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:maxRecords:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Int
$sel:marker:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:majorEngineVersion:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
$sel:filters:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe [Filter]
$sel:engineName:DescribeOptionGroups' :: DescribeOptionGroups -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeOptionGroups" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"EngineName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineName,
        ByteString
"Filters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        ByteString
"MajorEngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
majorEngineVersion,
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxRecords" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxRecords,
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName
      ]

-- | List of option groups.
--
-- /See:/ 'newDescribeOptionGroupsResponse' smart constructor.
data DescribeOptionGroupsResponse = DescribeOptionGroupsResponse'
  { -- | An optional pagination token provided by a previous request. If this
    -- parameter is specified, the response includes only records beyond the
    -- marker, up to the value specified by @MaxRecords@.
    DescribeOptionGroupsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | List of option groups.
    DescribeOptionGroupsResponse -> Maybe [OptionGroup]
optionGroupsList :: Prelude.Maybe [OptionGroup],
    -- | The response's http status code.
    DescribeOptionGroupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeOptionGroupsResponse
-> DescribeOptionGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeOptionGroupsResponse
-> DescribeOptionGroupsResponse -> Bool
$c/= :: DescribeOptionGroupsResponse
-> DescribeOptionGroupsResponse -> Bool
== :: DescribeOptionGroupsResponse
-> DescribeOptionGroupsResponse -> Bool
$c== :: DescribeOptionGroupsResponse
-> DescribeOptionGroupsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeOptionGroupsResponse]
ReadPrec DescribeOptionGroupsResponse
Int -> ReadS DescribeOptionGroupsResponse
ReadS [DescribeOptionGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeOptionGroupsResponse]
$creadListPrec :: ReadPrec [DescribeOptionGroupsResponse]
readPrec :: ReadPrec DescribeOptionGroupsResponse
$creadPrec :: ReadPrec DescribeOptionGroupsResponse
readList :: ReadS [DescribeOptionGroupsResponse]
$creadList :: ReadS [DescribeOptionGroupsResponse]
readsPrec :: Int -> ReadS DescribeOptionGroupsResponse
$creadsPrec :: Int -> ReadS DescribeOptionGroupsResponse
Prelude.Read, Int -> DescribeOptionGroupsResponse -> ShowS
[DescribeOptionGroupsResponse] -> ShowS
DescribeOptionGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeOptionGroupsResponse] -> ShowS
$cshowList :: [DescribeOptionGroupsResponse] -> ShowS
show :: DescribeOptionGroupsResponse -> String
$cshow :: DescribeOptionGroupsResponse -> String
showsPrec :: Int -> DescribeOptionGroupsResponse -> ShowS
$cshowsPrec :: Int -> DescribeOptionGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeOptionGroupsResponse x -> DescribeOptionGroupsResponse
forall x.
DescribeOptionGroupsResponse -> Rep DescribeOptionGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeOptionGroupsResponse x -> DescribeOptionGroupsResponse
$cfrom :: forall x.
DescribeOptionGroupsResponse -> Rep DescribeOptionGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeOptionGroupsResponse' 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:
--
-- 'marker', 'describeOptionGroupsResponse_marker' - An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
--
-- 'optionGroupsList', 'describeOptionGroupsResponse_optionGroupsList' - List of option groups.
--
-- 'httpStatus', 'describeOptionGroupsResponse_httpStatus' - The response's http status code.
newDescribeOptionGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeOptionGroupsResponse
newDescribeOptionGroupsResponse :: Int -> DescribeOptionGroupsResponse
newDescribeOptionGroupsResponse Int
pHttpStatus_ =
  DescribeOptionGroupsResponse'
    { $sel:marker:DescribeOptionGroupsResponse' :: Maybe Text
marker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:optionGroupsList:DescribeOptionGroupsResponse' :: Maybe [OptionGroup]
optionGroupsList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeOptionGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
describeOptionGroupsResponse_marker :: Lens.Lens' DescribeOptionGroupsResponse (Prelude.Maybe Prelude.Text)
describeOptionGroupsResponse_marker :: Lens' DescribeOptionGroupsResponse (Maybe Text)
describeOptionGroupsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroupsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeOptionGroupsResponse
s@DescribeOptionGroupsResponse' {} Maybe Text
a -> DescribeOptionGroupsResponse
s {$sel:marker:DescribeOptionGroupsResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeOptionGroupsResponse)

-- | List of option groups.
describeOptionGroupsResponse_optionGroupsList :: Lens.Lens' DescribeOptionGroupsResponse (Prelude.Maybe [OptionGroup])
describeOptionGroupsResponse_optionGroupsList :: Lens' DescribeOptionGroupsResponse (Maybe [OptionGroup])
describeOptionGroupsResponse_optionGroupsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroupsResponse' {Maybe [OptionGroup]
optionGroupsList :: Maybe [OptionGroup]
$sel:optionGroupsList:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Maybe [OptionGroup]
optionGroupsList} -> Maybe [OptionGroup]
optionGroupsList) (\s :: DescribeOptionGroupsResponse
s@DescribeOptionGroupsResponse' {} Maybe [OptionGroup]
a -> DescribeOptionGroupsResponse
s {$sel:optionGroupsList:DescribeOptionGroupsResponse' :: Maybe [OptionGroup]
optionGroupsList = Maybe [OptionGroup]
a} :: DescribeOptionGroupsResponse) 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.
describeOptionGroupsResponse_httpStatus :: Lens.Lens' DescribeOptionGroupsResponse Prelude.Int
describeOptionGroupsResponse_httpStatus :: Lens' DescribeOptionGroupsResponse Int
describeOptionGroupsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeOptionGroupsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeOptionGroupsResponse
s@DescribeOptionGroupsResponse' {} Int
a -> DescribeOptionGroupsResponse
s {$sel:httpStatus:DescribeOptionGroupsResponse' :: Int
httpStatus = Int
a} :: DescribeOptionGroupsResponse)

instance Prelude.NFData DescribeOptionGroupsResponse where
  rnf :: DescribeOptionGroupsResponse -> ()
rnf DescribeOptionGroupsResponse' {Int
Maybe [OptionGroup]
Maybe Text
httpStatus :: Int
optionGroupsList :: Maybe [OptionGroup]
marker :: Maybe Text
$sel:httpStatus:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Int
$sel:optionGroupsList:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Maybe [OptionGroup]
$sel:marker:DescribeOptionGroupsResponse' :: DescribeOptionGroupsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OptionGroup]
optionGroupsList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus