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