module Stratosphere.Bedrock.DataSource.BedrockFoundationModelContextEnrichmentConfigurationProperty (
module Exports,
BedrockFoundationModelContextEnrichmentConfigurationProperty(..),
mkBedrockFoundationModelContextEnrichmentConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Bedrock.DataSource.EnrichmentStrategyConfigurationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data BedrockFoundationModelContextEnrichmentConfigurationProperty
=
BedrockFoundationModelContextEnrichmentConfigurationProperty {BedrockFoundationModelContextEnrichmentConfigurationProperty -> ()
haddock_workaround_ :: (),
BedrockFoundationModelContextEnrichmentConfigurationProperty
-> EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty,
BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value Text
modelArn :: (Value Prelude.Text)}
deriving stock (BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool
(BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool)
-> (BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool)
-> Eq BedrockFoundationModelContextEnrichmentConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool
== :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool
$c/= :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool
/= :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Bool
Prelude.Eq, Int
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> ShowS
[BedrockFoundationModelContextEnrichmentConfigurationProperty]
-> ShowS
BedrockFoundationModelContextEnrichmentConfigurationProperty
-> String
(Int
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> ShowS)
-> (BedrockFoundationModelContextEnrichmentConfigurationProperty
-> String)
-> ([BedrockFoundationModelContextEnrichmentConfigurationProperty]
-> ShowS)
-> Show
BedrockFoundationModelContextEnrichmentConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> ShowS
showsPrec :: Int
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> ShowS
$cshow :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> String
show :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> String
$cshowList :: [BedrockFoundationModelContextEnrichmentConfigurationProperty]
-> ShowS
showList :: [BedrockFoundationModelContextEnrichmentConfigurationProperty]
-> ShowS
Prelude.Show)
mkBedrockFoundationModelContextEnrichmentConfigurationProperty ::
EnrichmentStrategyConfigurationProperty
-> Value Prelude.Text
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
mkBedrockFoundationModelContextEnrichmentConfigurationProperty :: EnrichmentStrategyConfigurationProperty
-> Value Text
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
mkBedrockFoundationModelContextEnrichmentConfigurationProperty
EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration
Value Text
modelArn
= BedrockFoundationModelContextEnrichmentConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (),
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration = EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration,
modelArn :: Value Text
modelArn = Value Text
modelArn}
instance ToResourceProperties BedrockFoundationModelContextEnrichmentConfigurationProperty where
toResourceProperties :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> ResourceProperties
toResourceProperties
BedrockFoundationModelContextEnrichmentConfigurationProperty {()
Value Text
EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: BedrockFoundationModelContextEnrichmentConfigurationProperty -> ()
enrichmentStrategyConfiguration :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> EnrichmentStrategyConfigurationProperty
modelArn :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value Text
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
modelArn :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Bedrock::DataSource.BedrockFoundationModelContextEnrichmentConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"EnrichmentStrategyConfiguration"
Key -> EnrichmentStrategyConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration,
Key
"ModelArn" 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
modelArn]}
instance JSON.ToJSON BedrockFoundationModelContextEnrichmentConfigurationProperty where
toJSON :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value
toJSON
BedrockFoundationModelContextEnrichmentConfigurationProperty {()
Value Text
EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: BedrockFoundationModelContextEnrichmentConfigurationProperty -> ()
enrichmentStrategyConfiguration :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> EnrichmentStrategyConfigurationProperty
modelArn :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value Text
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
modelArn :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"EnrichmentStrategyConfiguration"
Key -> EnrichmentStrategyConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration,
Key
"ModelArn" 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
modelArn]
instance Property "EnrichmentStrategyConfiguration" BedrockFoundationModelContextEnrichmentConfigurationProperty where
type PropertyType "EnrichmentStrategyConfiguration" BedrockFoundationModelContextEnrichmentConfigurationProperty = EnrichmentStrategyConfigurationProperty
set :: PropertyType
"EnrichmentStrategyConfiguration"
BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
set
PropertyType
"EnrichmentStrategyConfiguration"
BedrockFoundationModelContextEnrichmentConfigurationProperty
newValue
BedrockFoundationModelContextEnrichmentConfigurationProperty {()
Value Text
EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: BedrockFoundationModelContextEnrichmentConfigurationProperty -> ()
enrichmentStrategyConfiguration :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> EnrichmentStrategyConfigurationProperty
modelArn :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value Text
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
modelArn :: Value Text
..}
= BedrockFoundationModelContextEnrichmentConfigurationProperty
{enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
enrichmentStrategyConfiguration = PropertyType
"EnrichmentStrategyConfiguration"
BedrockFoundationModelContextEnrichmentConfigurationProperty
EnrichmentStrategyConfigurationProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
modelArn :: Value Text
haddock_workaround_ :: ()
modelArn :: Value Text
..}
instance Property "ModelArn" BedrockFoundationModelContextEnrichmentConfigurationProperty where
type PropertyType "ModelArn" BedrockFoundationModelContextEnrichmentConfigurationProperty = Value Prelude.Text
set :: PropertyType
"ModelArn"
BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
-> BedrockFoundationModelContextEnrichmentConfigurationProperty
set
PropertyType
"ModelArn"
BedrockFoundationModelContextEnrichmentConfigurationProperty
newValue
BedrockFoundationModelContextEnrichmentConfigurationProperty {()
Value Text
EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: BedrockFoundationModelContextEnrichmentConfigurationProperty -> ()
enrichmentStrategyConfiguration :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> EnrichmentStrategyConfigurationProperty
modelArn :: BedrockFoundationModelContextEnrichmentConfigurationProperty
-> Value Text
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
modelArn :: Value Text
..}
= BedrockFoundationModelContextEnrichmentConfigurationProperty
{modelArn :: Value Text
modelArn = PropertyType
"ModelArn"
BedrockFoundationModelContextEnrichmentConfigurationProperty
Value Text
newValue, ()
EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
haddock_workaround_ :: ()
enrichmentStrategyConfiguration :: EnrichmentStrategyConfigurationProperty
..}