module Stratosphere.Bedrock.KnowledgeBase.RedshiftServerlessConfigurationProperty (
module Exports, RedshiftServerlessConfigurationProperty(..),
mkRedshiftServerlessConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Bedrock.KnowledgeBase.RedshiftServerlessAuthConfigurationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data RedshiftServerlessConfigurationProperty
=
RedshiftServerlessConfigurationProperty {RedshiftServerlessConfigurationProperty -> ()
haddock_workaround_ :: (),
RedshiftServerlessConfigurationProperty
-> RedshiftServerlessAuthConfigurationProperty
authConfiguration :: RedshiftServerlessAuthConfigurationProperty,
RedshiftServerlessConfigurationProperty -> Value Text
workgroupArn :: (Value Prelude.Text)}
deriving stock (RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool
(RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool)
-> (RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool)
-> Eq RedshiftServerlessConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool
== :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool
$c/= :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool
/= :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty -> Bool
Prelude.Eq, Int -> RedshiftServerlessConfigurationProperty -> ShowS
[RedshiftServerlessConfigurationProperty] -> ShowS
RedshiftServerlessConfigurationProperty -> String
(Int -> RedshiftServerlessConfigurationProperty -> ShowS)
-> (RedshiftServerlessConfigurationProperty -> String)
-> ([RedshiftServerlessConfigurationProperty] -> ShowS)
-> Show RedshiftServerlessConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RedshiftServerlessConfigurationProperty -> ShowS
showsPrec :: Int -> RedshiftServerlessConfigurationProperty -> ShowS
$cshow :: RedshiftServerlessConfigurationProperty -> String
show :: RedshiftServerlessConfigurationProperty -> String
$cshowList :: [RedshiftServerlessConfigurationProperty] -> ShowS
showList :: [RedshiftServerlessConfigurationProperty] -> ShowS
Prelude.Show)
mkRedshiftServerlessConfigurationProperty ::
RedshiftServerlessAuthConfigurationProperty
-> Value Prelude.Text -> RedshiftServerlessConfigurationProperty
mkRedshiftServerlessConfigurationProperty :: RedshiftServerlessAuthConfigurationProperty
-> Value Text -> RedshiftServerlessConfigurationProperty
mkRedshiftServerlessConfigurationProperty
RedshiftServerlessAuthConfigurationProperty
authConfiguration
Value Text
workgroupArn
= RedshiftServerlessConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), authConfiguration :: RedshiftServerlessAuthConfigurationProperty
authConfiguration = RedshiftServerlessAuthConfigurationProperty
authConfiguration,
workgroupArn :: Value Text
workgroupArn = Value Text
workgroupArn}
instance ToResourceProperties RedshiftServerlessConfigurationProperty where
toResourceProperties :: RedshiftServerlessConfigurationProperty -> ResourceProperties
toResourceProperties RedshiftServerlessConfigurationProperty {()
Value Text
RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: RedshiftServerlessConfigurationProperty -> ()
authConfiguration :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessAuthConfigurationProperty
workgroupArn :: RedshiftServerlessConfigurationProperty -> Value Text
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
workgroupArn :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Bedrock::KnowledgeBase.RedshiftServerlessConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"AuthConfiguration" Key -> RedshiftServerlessAuthConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= RedshiftServerlessAuthConfigurationProperty
authConfiguration,
Key
"WorkgroupArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
workgroupArn]}
instance JSON.ToJSON RedshiftServerlessConfigurationProperty where
toJSON :: RedshiftServerlessConfigurationProperty -> Value
toJSON RedshiftServerlessConfigurationProperty {()
Value Text
RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: RedshiftServerlessConfigurationProperty -> ()
authConfiguration :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessAuthConfigurationProperty
workgroupArn :: RedshiftServerlessConfigurationProperty -> Value Text
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
workgroupArn :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"AuthConfiguration" Key -> RedshiftServerlessAuthConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= RedshiftServerlessAuthConfigurationProperty
authConfiguration,
Key
"WorkgroupArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
workgroupArn]
instance Property "AuthConfiguration" RedshiftServerlessConfigurationProperty where
type PropertyType "AuthConfiguration" RedshiftServerlessConfigurationProperty = RedshiftServerlessAuthConfigurationProperty
set :: PropertyType
"AuthConfiguration" RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty
set PropertyType
"AuthConfiguration" RedshiftServerlessConfigurationProperty
newValue RedshiftServerlessConfigurationProperty {()
Value Text
RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: RedshiftServerlessConfigurationProperty -> ()
authConfiguration :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessAuthConfigurationProperty
workgroupArn :: RedshiftServerlessConfigurationProperty -> Value Text
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
workgroupArn :: Value Text
..}
= RedshiftServerlessConfigurationProperty
{authConfiguration :: RedshiftServerlessAuthConfigurationProperty
authConfiguration = PropertyType
"AuthConfiguration" RedshiftServerlessConfigurationProperty
RedshiftServerlessAuthConfigurationProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
workgroupArn :: Value Text
haddock_workaround_ :: ()
workgroupArn :: Value Text
..}
instance Property "WorkgroupArn" RedshiftServerlessConfigurationProperty where
type PropertyType "WorkgroupArn" RedshiftServerlessConfigurationProperty = Value Prelude.Text
set :: PropertyType "WorkgroupArn" RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty
-> RedshiftServerlessConfigurationProperty
set PropertyType "WorkgroupArn" RedshiftServerlessConfigurationProperty
newValue RedshiftServerlessConfigurationProperty {()
Value Text
RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: RedshiftServerlessConfigurationProperty -> ()
authConfiguration :: RedshiftServerlessConfigurationProperty
-> RedshiftServerlessAuthConfigurationProperty
workgroupArn :: RedshiftServerlessConfigurationProperty -> Value Text
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
workgroupArn :: Value Text
..}
= RedshiftServerlessConfigurationProperty
{workgroupArn :: Value Text
workgroupArn = PropertyType "WorkgroupArn" RedshiftServerlessConfigurationProperty
Value Text
newValue, ()
RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
haddock_workaround_ :: ()
authConfiguration :: RedshiftServerlessAuthConfigurationProperty
..}