module Stratosphere.Bedrock.Flow.PromptFlowNodeConfigurationProperty (
        module Exports, PromptFlowNodeConfigurationProperty(..),
        mkPromptFlowNodeConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Bedrock.Flow.GuardrailConfigurationProperty as Exports
import {-# SOURCE #-} Stratosphere.Bedrock.Flow.PromptFlowNodeSourceConfigurationProperty as Exports
import Stratosphere.ResourceProperties
data PromptFlowNodeConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-bedrock-flow-promptflownodeconfiguration.html>
    PromptFlowNodeConfigurationProperty {PromptFlowNodeConfigurationProperty -> ()
haddock_workaround_ :: (),
                                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-bedrock-flow-promptflownodeconfiguration.html#cfn-bedrock-flow-promptflownodeconfiguration-guardrailconfiguration>
                                         PromptFlowNodeConfigurationProperty
-> Maybe GuardrailConfigurationProperty
guardrailConfiguration :: (Prelude.Maybe GuardrailConfigurationProperty),
                                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-bedrock-flow-promptflownodeconfiguration.html#cfn-bedrock-flow-promptflownodeconfiguration-sourceconfiguration>
                                         PromptFlowNodeConfigurationProperty
-> PromptFlowNodeSourceConfigurationProperty
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty}
  deriving stock (PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty -> Bool
(PromptFlowNodeConfigurationProperty
 -> PromptFlowNodeConfigurationProperty -> Bool)
-> (PromptFlowNodeConfigurationProperty
    -> PromptFlowNodeConfigurationProperty -> Bool)
-> Eq PromptFlowNodeConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty -> Bool
== :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty -> Bool
$c/= :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty -> Bool
/= :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty -> Bool
Prelude.Eq, Int -> PromptFlowNodeConfigurationProperty -> ShowS
[PromptFlowNodeConfigurationProperty] -> ShowS
PromptFlowNodeConfigurationProperty -> String
(Int -> PromptFlowNodeConfigurationProperty -> ShowS)
-> (PromptFlowNodeConfigurationProperty -> String)
-> ([PromptFlowNodeConfigurationProperty] -> ShowS)
-> Show PromptFlowNodeConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptFlowNodeConfigurationProperty -> ShowS
showsPrec :: Int -> PromptFlowNodeConfigurationProperty -> ShowS
$cshow :: PromptFlowNodeConfigurationProperty -> String
show :: PromptFlowNodeConfigurationProperty -> String
$cshowList :: [PromptFlowNodeConfigurationProperty] -> ShowS
showList :: [PromptFlowNodeConfigurationProperty] -> ShowS
Prelude.Show)
mkPromptFlowNodeConfigurationProperty ::
  PromptFlowNodeSourceConfigurationProperty
  -> PromptFlowNodeConfigurationProperty
mkPromptFlowNodeConfigurationProperty :: PromptFlowNodeSourceConfigurationProperty
-> PromptFlowNodeConfigurationProperty
mkPromptFlowNodeConfigurationProperty PromptFlowNodeSourceConfigurationProperty
sourceConfiguration
  = PromptFlowNodeConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
sourceConfiguration = PromptFlowNodeSourceConfigurationProperty
sourceConfiguration,
       guardrailConfiguration :: Maybe GuardrailConfigurationProperty
guardrailConfiguration = Maybe GuardrailConfigurationProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties PromptFlowNodeConfigurationProperty where
  toResourceProperties :: PromptFlowNodeConfigurationProperty -> ResourceProperties
toResourceProperties PromptFlowNodeConfigurationProperty {Maybe GuardrailConfigurationProperty
()
PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: PromptFlowNodeConfigurationProperty -> ()
guardrailConfiguration :: PromptFlowNodeConfigurationProperty
-> Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Bedrock::Flow.PromptFlowNodeConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"SourceConfiguration" Key -> PromptFlowNodeSourceConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= PromptFlowNodeSourceConfigurationProperty
sourceConfiguration]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> GuardrailConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"GuardrailConfiguration"
                                 (GuardrailConfigurationProperty -> (Key, Value))
-> Maybe GuardrailConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe GuardrailConfigurationProperty
guardrailConfiguration]))}
instance JSON.ToJSON PromptFlowNodeConfigurationProperty where
  toJSON :: PromptFlowNodeConfigurationProperty -> Value
toJSON PromptFlowNodeConfigurationProperty {Maybe GuardrailConfigurationProperty
()
PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: PromptFlowNodeConfigurationProperty -> ()
guardrailConfiguration :: PromptFlowNodeConfigurationProperty
-> Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"SourceConfiguration" Key -> PromptFlowNodeSourceConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= PromptFlowNodeSourceConfigurationProperty
sourceConfiguration]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> GuardrailConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"GuardrailConfiguration"
                    (GuardrailConfigurationProperty -> (Key, Value))
-> Maybe GuardrailConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe GuardrailConfigurationProperty
guardrailConfiguration])))
instance Property "GuardrailConfiguration" PromptFlowNodeConfigurationProperty where
  type PropertyType "GuardrailConfiguration" PromptFlowNodeConfigurationProperty = GuardrailConfigurationProperty
  set :: PropertyType
  "GuardrailConfiguration" PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty
set PropertyType
  "GuardrailConfiguration" PromptFlowNodeConfigurationProperty
newValue PromptFlowNodeConfigurationProperty {Maybe GuardrailConfigurationProperty
()
PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: PromptFlowNodeConfigurationProperty -> ()
guardrailConfiguration :: PromptFlowNodeConfigurationProperty
-> Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
..}
    = PromptFlowNodeConfigurationProperty
        {guardrailConfiguration :: Maybe GuardrailConfigurationProperty
guardrailConfiguration = GuardrailConfigurationProperty
-> Maybe GuardrailConfigurationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "GuardrailConfiguration" PromptFlowNodeConfigurationProperty
GuardrailConfigurationProperty
newValue, ()
PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
..}
instance Property "SourceConfiguration" PromptFlowNodeConfigurationProperty where
  type PropertyType "SourceConfiguration" PromptFlowNodeConfigurationProperty = PromptFlowNodeSourceConfigurationProperty
  set :: PropertyType
  "SourceConfiguration" PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty
-> PromptFlowNodeConfigurationProperty
set PropertyType
  "SourceConfiguration" PromptFlowNodeConfigurationProperty
newValue PromptFlowNodeConfigurationProperty {Maybe GuardrailConfigurationProperty
()
PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: PromptFlowNodeConfigurationProperty -> ()
guardrailConfiguration :: PromptFlowNodeConfigurationProperty
-> Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeConfigurationProperty
-> PromptFlowNodeSourceConfigurationProperty
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
..}
    = PromptFlowNodeConfigurationProperty
        {sourceConfiguration :: PromptFlowNodeSourceConfigurationProperty
sourceConfiguration = PropertyType
  "SourceConfiguration" PromptFlowNodeConfigurationProperty
PromptFlowNodeSourceConfigurationProperty
newValue, Maybe GuardrailConfigurationProperty
()
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
haddock_workaround_ :: ()
guardrailConfiguration :: Maybe GuardrailConfigurationProperty
..}