module Stratosphere.APS.Workspace.QueryLoggingConfigurationProperty (
        module Exports, QueryLoggingConfigurationProperty(..),
        mkQueryLoggingConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.APS.Workspace.LoggingDestinationProperty as Exports
import Stratosphere.ResourceProperties
data QueryLoggingConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-aps-workspace-queryloggingconfiguration.html>
    QueryLoggingConfigurationProperty {QueryLoggingConfigurationProperty -> ()
haddock_workaround_ :: (),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-aps-workspace-queryloggingconfiguration.html#cfn-aps-workspace-queryloggingconfiguration-destinations>
                                       QueryLoggingConfigurationProperty -> [LoggingDestinationProperty]
destinations :: [LoggingDestinationProperty]}
  deriving stock (QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty -> Bool
(QueryLoggingConfigurationProperty
 -> QueryLoggingConfigurationProperty -> Bool)
-> (QueryLoggingConfigurationProperty
    -> QueryLoggingConfigurationProperty -> Bool)
-> Eq QueryLoggingConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty -> Bool
== :: QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty -> Bool
$c/= :: QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty -> Bool
/= :: QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty -> Bool
Prelude.Eq, Int -> QueryLoggingConfigurationProperty -> ShowS
[QueryLoggingConfigurationProperty] -> ShowS
QueryLoggingConfigurationProperty -> String
(Int -> QueryLoggingConfigurationProperty -> ShowS)
-> (QueryLoggingConfigurationProperty -> String)
-> ([QueryLoggingConfigurationProperty] -> ShowS)
-> Show QueryLoggingConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryLoggingConfigurationProperty -> ShowS
showsPrec :: Int -> QueryLoggingConfigurationProperty -> ShowS
$cshow :: QueryLoggingConfigurationProperty -> String
show :: QueryLoggingConfigurationProperty -> String
$cshowList :: [QueryLoggingConfigurationProperty] -> ShowS
showList :: [QueryLoggingConfigurationProperty] -> ShowS
Prelude.Show)
mkQueryLoggingConfigurationProperty ::
  [LoggingDestinationProperty] -> QueryLoggingConfigurationProperty
mkQueryLoggingConfigurationProperty :: [LoggingDestinationProperty] -> QueryLoggingConfigurationProperty
mkQueryLoggingConfigurationProperty [LoggingDestinationProperty]
destinations
  = QueryLoggingConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), destinations :: [LoggingDestinationProperty]
destinations = [LoggingDestinationProperty]
destinations}
instance ToResourceProperties QueryLoggingConfigurationProperty where
  toResourceProperties :: QueryLoggingConfigurationProperty -> ResourceProperties
toResourceProperties QueryLoggingConfigurationProperty {[LoggingDestinationProperty]
()
haddock_workaround_ :: QueryLoggingConfigurationProperty -> ()
destinations :: QueryLoggingConfigurationProperty -> [LoggingDestinationProperty]
haddock_workaround_ :: ()
destinations :: [LoggingDestinationProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::APS::Workspace.QueryLoggingConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Destinations" Key -> [LoggingDestinationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [LoggingDestinationProperty]
destinations]}
instance JSON.ToJSON QueryLoggingConfigurationProperty where
  toJSON :: QueryLoggingConfigurationProperty -> Value
toJSON QueryLoggingConfigurationProperty {[LoggingDestinationProperty]
()
haddock_workaround_ :: QueryLoggingConfigurationProperty -> ()
destinations :: QueryLoggingConfigurationProperty -> [LoggingDestinationProperty]
haddock_workaround_ :: ()
destinations :: [LoggingDestinationProperty]
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Destinations" Key -> [LoggingDestinationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [LoggingDestinationProperty]
destinations]
instance Property "Destinations" QueryLoggingConfigurationProperty where
  type PropertyType "Destinations" QueryLoggingConfigurationProperty = [LoggingDestinationProperty]
  set :: PropertyType "Destinations" QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty
-> QueryLoggingConfigurationProperty
set PropertyType "Destinations" QueryLoggingConfigurationProperty
newValue QueryLoggingConfigurationProperty {[LoggingDestinationProperty]
()
haddock_workaround_ :: QueryLoggingConfigurationProperty -> ()
destinations :: QueryLoggingConfigurationProperty -> [LoggingDestinationProperty]
haddock_workaround_ :: ()
destinations :: [LoggingDestinationProperty]
..}
    = QueryLoggingConfigurationProperty {destinations :: [LoggingDestinationProperty]
destinations = [LoggingDestinationProperty]
PropertyType "Destinations" QueryLoggingConfigurationProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}