module Stratosphere.Lex.Bot.BedrockAgentIntentConfigurationProperty (
        module Exports, BedrockAgentIntentConfigurationProperty(..),
        mkBedrockAgentIntentConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Lex.Bot.BedrockAgentConfigurationProperty as Exports
import {-# SOURCE #-} Stratosphere.Lex.Bot.BedrockAgentIntentKnowledgeBaseConfigurationProperty as Exports
import Stratosphere.ResourceProperties
data BedrockAgentIntentConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-bedrockagentintentconfiguration.html>
    BedrockAgentIntentConfigurationProperty {BedrockAgentIntentConfigurationProperty -> ()
haddock_workaround_ :: (),
                                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-bedrockagentintentconfiguration.html#cfn-lex-bot-bedrockagentintentconfiguration-bedrockagentconfiguration>
                                             BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
bedrockAgentConfiguration :: (Prelude.Maybe BedrockAgentConfigurationProperty),
                                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-bedrockagentintentconfiguration.html#cfn-lex-bot-bedrockagentintentconfiguration-bedrockagentintentknowledgebaseconfiguration>
                                             BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: (Prelude.Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty)}
  deriving stock (BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty -> Bool
(BedrockAgentIntentConfigurationProperty
 -> BedrockAgentIntentConfigurationProperty -> Bool)
-> (BedrockAgentIntentConfigurationProperty
    -> BedrockAgentIntentConfigurationProperty -> Bool)
-> Eq BedrockAgentIntentConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty -> Bool
== :: BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty -> Bool
$c/= :: BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty -> Bool
/= :: BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty -> Bool
Prelude.Eq, Int -> BedrockAgentIntentConfigurationProperty -> ShowS
[BedrockAgentIntentConfigurationProperty] -> ShowS
BedrockAgentIntentConfigurationProperty -> String
(Int -> BedrockAgentIntentConfigurationProperty -> ShowS)
-> (BedrockAgentIntentConfigurationProperty -> String)
-> ([BedrockAgentIntentConfigurationProperty] -> ShowS)
-> Show BedrockAgentIntentConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BedrockAgentIntentConfigurationProperty -> ShowS
showsPrec :: Int -> BedrockAgentIntentConfigurationProperty -> ShowS
$cshow :: BedrockAgentIntentConfigurationProperty -> String
show :: BedrockAgentIntentConfigurationProperty -> String
$cshowList :: [BedrockAgentIntentConfigurationProperty] -> ShowS
showList :: [BedrockAgentIntentConfigurationProperty] -> ShowS
Prelude.Show)
mkBedrockAgentIntentConfigurationProperty ::
  BedrockAgentIntentConfigurationProperty
mkBedrockAgentIntentConfigurationProperty :: BedrockAgentIntentConfigurationProperty
mkBedrockAgentIntentConfigurationProperty
  = BedrockAgentIntentConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentConfiguration = Maybe BedrockAgentConfigurationProperty
forall a. Maybe a
Prelude.Nothing,
       bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration = Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties BedrockAgentIntentConfigurationProperty where
  toResourceProperties :: BedrockAgentIntentConfigurationProperty -> ResourceProperties
toResourceProperties BedrockAgentIntentConfigurationProperty {Maybe BedrockAgentConfigurationProperty
Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
()
haddock_workaround_ :: BedrockAgentIntentConfigurationProperty -> ()
bedrockAgentConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Lex::Bot.BedrockAgentIntentConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> BedrockAgentConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BedrockAgentConfiguration"
                              (BedrockAgentConfigurationProperty -> (Key, Value))
-> Maybe BedrockAgentConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BedrockAgentConfigurationProperty
bedrockAgentConfiguration,
                            Key
-> BedrockAgentIntentKnowledgeBaseConfigurationProperty
-> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BedrockAgentIntentKnowledgeBaseConfiguration"
                              (BedrockAgentIntentKnowledgeBaseConfigurationProperty
 -> (Key, Value))
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration])}
instance JSON.ToJSON BedrockAgentIntentConfigurationProperty where
  toJSON :: BedrockAgentIntentConfigurationProperty -> Value
toJSON BedrockAgentIntentConfigurationProperty {Maybe BedrockAgentConfigurationProperty
Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
()
haddock_workaround_ :: BedrockAgentIntentConfigurationProperty -> ()
bedrockAgentConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> BedrockAgentConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BedrockAgentConfiguration"
                 (BedrockAgentConfigurationProperty -> (Key, Value))
-> Maybe BedrockAgentConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BedrockAgentConfigurationProperty
bedrockAgentConfiguration,
               Key
-> BedrockAgentIntentKnowledgeBaseConfigurationProperty
-> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BedrockAgentIntentKnowledgeBaseConfiguration"
                 (BedrockAgentIntentKnowledgeBaseConfigurationProperty
 -> (Key, Value))
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration]))
instance Property "BedrockAgentConfiguration" BedrockAgentIntentConfigurationProperty where
  type PropertyType "BedrockAgentConfiguration" BedrockAgentIntentConfigurationProperty = BedrockAgentConfigurationProperty
  set :: PropertyType
  "BedrockAgentConfiguration" BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty
set PropertyType
  "BedrockAgentConfiguration" BedrockAgentIntentConfigurationProperty
newValue BedrockAgentIntentConfigurationProperty {Maybe BedrockAgentConfigurationProperty
Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
()
haddock_workaround_ :: BedrockAgentIntentConfigurationProperty -> ()
bedrockAgentConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
..}
    = BedrockAgentIntentConfigurationProperty
        {bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentConfiguration = BedrockAgentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "BedrockAgentConfiguration" BedrockAgentIntentConfigurationProperty
BedrockAgentConfigurationProperty
newValue, Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
()
haddock_workaround_ :: ()
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
..}
instance Property "BedrockAgentIntentKnowledgeBaseConfiguration" BedrockAgentIntentConfigurationProperty where
  type PropertyType "BedrockAgentIntentKnowledgeBaseConfiguration" BedrockAgentIntentConfigurationProperty = BedrockAgentIntentKnowledgeBaseConfigurationProperty
  set :: PropertyType
  "BedrockAgentIntentKnowledgeBaseConfiguration"
  BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty
-> BedrockAgentIntentConfigurationProperty
set PropertyType
  "BedrockAgentIntentKnowledgeBaseConfiguration"
  BedrockAgentIntentConfigurationProperty
newValue BedrockAgentIntentConfigurationProperty {Maybe BedrockAgentConfigurationProperty
Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
()
haddock_workaround_ :: BedrockAgentIntentConfigurationProperty -> ()
bedrockAgentConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: BedrockAgentIntentConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
..}
    = BedrockAgentIntentConfigurationProperty
        {bedrockAgentIntentKnowledgeBaseConfiguration :: Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
bedrockAgentIntentKnowledgeBaseConfiguration = BedrockAgentIntentKnowledgeBaseConfigurationProperty
-> Maybe BedrockAgentIntentKnowledgeBaseConfigurationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
                                                          PropertyType
  "BedrockAgentIntentKnowledgeBaseConfiguration"
  BedrockAgentIntentConfigurationProperty
BedrockAgentIntentKnowledgeBaseConfigurationProperty
newValue,
         Maybe BedrockAgentConfigurationProperty
()
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
haddock_workaround_ :: ()
bedrockAgentConfiguration :: Maybe BedrockAgentConfigurationProperty
..}