{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Option
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.RDS.Types.Option 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.DBSecurityGroupMembership
import Amazonka.RDS.Types.OptionSetting
import Amazonka.RDS.Types.VpcSecurityGroupMembership

-- | Option details.
--
-- /See:/ 'newOption' smart constructor.
data Option = Option'
  { -- | If the option requires access to a port, then this DB security group
    -- allows access to the port.
    Option -> Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships :: Prelude.Maybe [DBSecurityGroupMembership],
    -- | The description of the option.
    Option -> Maybe Text
optionDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the option.
    Option -> Maybe Text
optionName :: Prelude.Maybe Prelude.Text,
    -- | The option settings for this option.
    Option -> Maybe [OptionSetting]
optionSettings :: Prelude.Maybe [OptionSetting],
    -- | The version of the option.
    Option -> Maybe Text
optionVersion :: Prelude.Maybe Prelude.Text,
    -- | Indicate if this option is permanent.
    Option -> Maybe Bool
permanent :: Prelude.Maybe Prelude.Bool,
    -- | Indicate if this option is persistent.
    Option -> Maybe Bool
persistent :: Prelude.Maybe Prelude.Bool,
    -- | If required, the port configured for this option to use.
    Option -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | If the option requires access to a port, then this VPC security group
    -- allows access to the port.
    Option -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships :: Prelude.Maybe [VpcSecurityGroupMembership]
  }
  deriving (Option -> Option -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Prelude.Eq, ReadPrec [Option]
ReadPrec Option
Int -> ReadS Option
ReadS [Option]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Option]
$creadListPrec :: ReadPrec [Option]
readPrec :: ReadPrec Option
$creadPrec :: ReadPrec Option
readList :: ReadS [Option]
$creadList :: ReadS [Option]
readsPrec :: Int -> ReadS Option
$creadsPrec :: Int -> ReadS Option
Prelude.Read, Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Prelude.Show, forall x. Rep Option x -> Option
forall x. Option -> Rep Option x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Option x -> Option
$cfrom :: forall x. Option -> Rep Option x
Prelude.Generic)

-- |
-- Create a value of 'Option' 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:
--
-- 'dbSecurityGroupMemberships', 'option_dbSecurityGroupMemberships' - If the option requires access to a port, then this DB security group
-- allows access to the port.
--
-- 'optionDescription', 'option_optionDescription' - The description of the option.
--
-- 'optionName', 'option_optionName' - The name of the option.
--
-- 'optionSettings', 'option_optionSettings' - The option settings for this option.
--
-- 'optionVersion', 'option_optionVersion' - The version of the option.
--
-- 'permanent', 'option_permanent' - Indicate if this option is permanent.
--
-- 'persistent', 'option_persistent' - Indicate if this option is persistent.
--
-- 'port', 'option_port' - If required, the port configured for this option to use.
--
-- 'vpcSecurityGroupMemberships', 'option_vpcSecurityGroupMemberships' - If the option requires access to a port, then this VPC security group
-- allows access to the port.
newOption ::
  Option
newOption :: Option
newOption =
  Option'
    { $sel:dbSecurityGroupMemberships:Option' :: Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships =
        forall a. Maybe a
Prelude.Nothing,
      $sel:optionDescription:Option' :: Maybe Text
optionDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:optionName:Option' :: Maybe Text
optionName = forall a. Maybe a
Prelude.Nothing,
      $sel:optionSettings:Option' :: Maybe [OptionSetting]
optionSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:optionVersion:Option' :: Maybe Text
optionVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:permanent:Option' :: Maybe Bool
permanent = forall a. Maybe a
Prelude.Nothing,
      $sel:persistent:Option' :: Maybe Bool
persistent = forall a. Maybe a
Prelude.Nothing,
      $sel:port:Option' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroupMemberships:Option' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships = forall a. Maybe a
Prelude.Nothing
    }

-- | If the option requires access to a port, then this DB security group
-- allows access to the port.
option_dbSecurityGroupMemberships :: Lens.Lens' Option (Prelude.Maybe [DBSecurityGroupMembership])
option_dbSecurityGroupMemberships :: Lens' Option (Maybe [DBSecurityGroupMembership])
option_dbSecurityGroupMemberships = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships :: Maybe [DBSecurityGroupMembership]
$sel:dbSecurityGroupMemberships:Option' :: Option -> Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships} -> Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships) (\s :: Option
s@Option' {} Maybe [DBSecurityGroupMembership]
a -> Option
s {$sel:dbSecurityGroupMemberships:Option' :: Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships = Maybe [DBSecurityGroupMembership]
a} :: Option) 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 description of the option.
option_optionDescription :: Lens.Lens' Option (Prelude.Maybe Prelude.Text)
option_optionDescription :: Lens' Option (Maybe Text)
option_optionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Text
optionDescription :: Maybe Text
$sel:optionDescription:Option' :: Option -> Maybe Text
optionDescription} -> Maybe Text
optionDescription) (\s :: Option
s@Option' {} Maybe Text
a -> Option
s {$sel:optionDescription:Option' :: Maybe Text
optionDescription = Maybe Text
a} :: Option)

-- | The name of the option.
option_optionName :: Lens.Lens' Option (Prelude.Maybe Prelude.Text)
option_optionName :: Lens' Option (Maybe Text)
option_optionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Text
optionName :: Maybe Text
$sel:optionName:Option' :: Option -> Maybe Text
optionName} -> Maybe Text
optionName) (\s :: Option
s@Option' {} Maybe Text
a -> Option
s {$sel:optionName:Option' :: Maybe Text
optionName = Maybe Text
a} :: Option)

-- | The option settings for this option.
option_optionSettings :: Lens.Lens' Option (Prelude.Maybe [OptionSetting])
option_optionSettings :: Lens' Option (Maybe [OptionSetting])
option_optionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe [OptionSetting]
optionSettings :: Maybe [OptionSetting]
$sel:optionSettings:Option' :: Option -> Maybe [OptionSetting]
optionSettings} -> Maybe [OptionSetting]
optionSettings) (\s :: Option
s@Option' {} Maybe [OptionSetting]
a -> Option
s {$sel:optionSettings:Option' :: Maybe [OptionSetting]
optionSettings = Maybe [OptionSetting]
a} :: Option) 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 version of the option.
option_optionVersion :: Lens.Lens' Option (Prelude.Maybe Prelude.Text)
option_optionVersion :: Lens' Option (Maybe Text)
option_optionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Text
optionVersion :: Maybe Text
$sel:optionVersion:Option' :: Option -> Maybe Text
optionVersion} -> Maybe Text
optionVersion) (\s :: Option
s@Option' {} Maybe Text
a -> Option
s {$sel:optionVersion:Option' :: Maybe Text
optionVersion = Maybe Text
a} :: Option)

-- | Indicate if this option is permanent.
option_permanent :: Lens.Lens' Option (Prelude.Maybe Prelude.Bool)
option_permanent :: Lens' Option (Maybe Bool)
option_permanent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Bool
permanent :: Maybe Bool
$sel:permanent:Option' :: Option -> Maybe Bool
permanent} -> Maybe Bool
permanent) (\s :: Option
s@Option' {} Maybe Bool
a -> Option
s {$sel:permanent:Option' :: Maybe Bool
permanent = Maybe Bool
a} :: Option)

-- | Indicate if this option is persistent.
option_persistent :: Lens.Lens' Option (Prelude.Maybe Prelude.Bool)
option_persistent :: Lens' Option (Maybe Bool)
option_persistent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Bool
persistent :: Maybe Bool
$sel:persistent:Option' :: Option -> Maybe Bool
persistent} -> Maybe Bool
persistent) (\s :: Option
s@Option' {} Maybe Bool
a -> Option
s {$sel:persistent:Option' :: Maybe Bool
persistent = Maybe Bool
a} :: Option)

-- | If required, the port configured for this option to use.
option_port :: Lens.Lens' Option (Prelude.Maybe Prelude.Int)
option_port :: Lens' Option (Maybe Int)
option_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe Int
port :: Maybe Int
$sel:port:Option' :: Option -> Maybe Int
port} -> Maybe Int
port) (\s :: Option
s@Option' {} Maybe Int
a -> Option
s {$sel:port:Option' :: Maybe Int
port = Maybe Int
a} :: Option)

-- | If the option requires access to a port, then this VPC security group
-- allows access to the port.
option_vpcSecurityGroupMemberships :: Lens.Lens' Option (Prelude.Maybe [VpcSecurityGroupMembership])
option_vpcSecurityGroupMemberships :: Lens' Option (Maybe [VpcSecurityGroupMembership])
option_vpcSecurityGroupMemberships = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Option' {Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships :: Maybe [VpcSecurityGroupMembership]
$sel:vpcSecurityGroupMemberships:Option' :: Option -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships} -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships) (\s :: Option
s@Option' {} Maybe [VpcSecurityGroupMembership]
a -> Option
s {$sel:vpcSecurityGroupMemberships:Option' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships = Maybe [VpcSecurityGroupMembership]
a} :: Option) 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

instance Data.FromXML Option where
  parseXML :: [Node] -> Either String Option
parseXML [Node]
x =
    Maybe [DBSecurityGroupMembership]
-> Maybe Text
-> Maybe Text
-> Maybe [OptionSetting]
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe [VpcSecurityGroupMembership]
-> Option
Option'
      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
"DBSecurityGroupMemberships"
                      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
"DBSecurityGroup")
                  )
      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
"OptionDescription")
      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
"OptionName")
      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
"OptionSettings"
                      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
"OptionSetting")
                  )
      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
"OptionVersion")
      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
"Permanent")
      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
"Persistent")
      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
"Port")
      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
"VpcSecurityGroupMemberships"
                      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
"VpcSecurityGroupMembership")
                  )

instance Prelude.Hashable Option where
  hashWithSalt :: Int -> Option -> Int
hashWithSalt Int
_salt Option' {Maybe Bool
Maybe Int
Maybe [DBSecurityGroupMembership]
Maybe [OptionSetting]
Maybe [VpcSecurityGroupMembership]
Maybe Text
vpcSecurityGroupMemberships :: Maybe [VpcSecurityGroupMembership]
port :: Maybe Int
persistent :: Maybe Bool
permanent :: Maybe Bool
optionVersion :: Maybe Text
optionSettings :: Maybe [OptionSetting]
optionName :: Maybe Text
optionDescription :: Maybe Text
dbSecurityGroupMemberships :: Maybe [DBSecurityGroupMembership]
$sel:vpcSecurityGroupMemberships:Option' :: Option -> Maybe [VpcSecurityGroupMembership]
$sel:port:Option' :: Option -> Maybe Int
$sel:persistent:Option' :: Option -> Maybe Bool
$sel:permanent:Option' :: Option -> Maybe Bool
$sel:optionVersion:Option' :: Option -> Maybe Text
$sel:optionSettings:Option' :: Option -> Maybe [OptionSetting]
$sel:optionName:Option' :: Option -> Maybe Text
$sel:optionDescription:Option' :: Option -> Maybe Text
$sel:dbSecurityGroupMemberships:Option' :: Option -> Maybe [DBSecurityGroupMembership]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OptionSetting]
optionSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
permanent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
persistent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships

instance Prelude.NFData Option where
  rnf :: Option -> ()
rnf Option' {Maybe Bool
Maybe Int
Maybe [DBSecurityGroupMembership]
Maybe [OptionSetting]
Maybe [VpcSecurityGroupMembership]
Maybe Text
vpcSecurityGroupMemberships :: Maybe [VpcSecurityGroupMembership]
port :: Maybe Int
persistent :: Maybe Bool
permanent :: Maybe Bool
optionVersion :: Maybe Text
optionSettings :: Maybe [OptionSetting]
optionName :: Maybe Text
optionDescription :: Maybe Text
dbSecurityGroupMemberships :: Maybe [DBSecurityGroupMembership]
$sel:vpcSecurityGroupMemberships:Option' :: Option -> Maybe [VpcSecurityGroupMembership]
$sel:port:Option' :: Option -> Maybe Int
$sel:persistent:Option' :: Option -> Maybe Bool
$sel:permanent:Option' :: Option -> Maybe Bool
$sel:optionVersion:Option' :: Option -> Maybe Text
$sel:optionSettings:Option' :: Option -> Maybe [OptionSetting]
$sel:optionName:Option' :: Option -> Maybe Text
$sel:optionDescription:Option' :: Option -> Maybe Text
$sel:dbSecurityGroupMemberships:Option' :: Option -> Maybe [DBSecurityGroupMembership]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DBSecurityGroupMembership]
dbSecurityGroupMemberships
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OptionSetting]
optionSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
permanent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
persistent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [VpcSecurityGroupMembership]
vpcSecurityGroupMemberships