module Stratosphere.Logs.Integration (
        module Exports, Integration(..), mkIntegration
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Logs.Integration.ResourceConfigProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Integration
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-logs-integration.html>
    Integration {Integration -> ()
haddock_workaround_ :: (),
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-logs-integration.html#cfn-logs-integration-integrationname>
                 Integration -> Value Text
integrationName :: (Value Prelude.Text),
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-logs-integration.html#cfn-logs-integration-integrationtype>
                 Integration -> Value Text
integrationType :: (Value Prelude.Text),
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-logs-integration.html#cfn-logs-integration-resourceconfig>
                 Integration -> ResourceConfigProperty
resourceConfig :: ResourceConfigProperty}
  deriving stock (Integration -> Integration -> Bool
(Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool) -> Eq Integration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Integration -> Integration -> Bool
== :: Integration -> Integration -> Bool
$c/= :: Integration -> Integration -> Bool
/= :: Integration -> Integration -> Bool
Prelude.Eq, Int -> Integration -> ShowS
[Integration] -> ShowS
Integration -> String
(Int -> Integration -> ShowS)
-> (Integration -> String)
-> ([Integration] -> ShowS)
-> Show Integration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Integration -> ShowS
showsPrec :: Int -> Integration -> ShowS
$cshow :: Integration -> String
show :: Integration -> String
$cshowList :: [Integration] -> ShowS
showList :: [Integration] -> ShowS
Prelude.Show)
mkIntegration ::
  Value Prelude.Text
  -> Value Prelude.Text -> ResourceConfigProperty -> Integration
mkIntegration :: Value Text -> Value Text -> ResourceConfigProperty -> Integration
mkIntegration Value Text
integrationName Value Text
integrationType ResourceConfigProperty
resourceConfig
  = Integration
      {haddock_workaround_ :: ()
haddock_workaround_ = (), integrationName :: Value Text
integrationName = Value Text
integrationName,
       integrationType :: Value Text
integrationType = Value Text
integrationType, resourceConfig :: ResourceConfigProperty
resourceConfig = ResourceConfigProperty
resourceConfig}
instance ToResourceProperties Integration where
  toResourceProperties :: Integration -> ResourceProperties
toResourceProperties Integration {()
Value Text
ResourceConfigProperty
haddock_workaround_ :: Integration -> ()
integrationName :: Integration -> Value Text
integrationType :: Integration -> Value Text
resourceConfig :: Integration -> ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Logs::Integration", supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"IntegrationName" 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
integrationName,
                       Key
"IntegrationType" 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
integrationType,
                       Key
"ResourceConfig" Key -> ResourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ResourceConfigProperty
resourceConfig]}
instance JSON.ToJSON Integration where
  toJSON :: Integration -> Value
toJSON Integration {()
Value Text
ResourceConfigProperty
haddock_workaround_ :: Integration -> ()
integrationName :: Integration -> Value Text
integrationType :: Integration -> Value Text
resourceConfig :: Integration -> ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"IntegrationName" 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
integrationName,
         Key
"IntegrationType" 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
integrationType,
         Key
"ResourceConfig" Key -> ResourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ResourceConfigProperty
resourceConfig]
instance Property "IntegrationName" Integration where
  type PropertyType "IntegrationName" Integration = Value Prelude.Text
  set :: PropertyType "IntegrationName" Integration
-> Integration -> Integration
set PropertyType "IntegrationName" Integration
newValue Integration {()
Value Text
ResourceConfigProperty
haddock_workaround_ :: Integration -> ()
integrationName :: Integration -> Value Text
integrationType :: Integration -> Value Text
resourceConfig :: Integration -> ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
    = Integration {integrationName :: Value Text
integrationName = PropertyType "IntegrationName" Integration
Value Text
newValue, ()
Value Text
ResourceConfigProperty
haddock_workaround_ :: ()
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
haddock_workaround_ :: ()
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
instance Property "IntegrationType" Integration where
  type PropertyType "IntegrationType" Integration = Value Prelude.Text
  set :: PropertyType "IntegrationType" Integration
-> Integration -> Integration
set PropertyType "IntegrationType" Integration
newValue Integration {()
Value Text
ResourceConfigProperty
haddock_workaround_ :: Integration -> ()
integrationName :: Integration -> Value Text
integrationType :: Integration -> Value Text
resourceConfig :: Integration -> ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
    = Integration {integrationType :: Value Text
integrationType = PropertyType "IntegrationType" Integration
Value Text
newValue, ()
Value Text
ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
resourceConfig :: ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
resourceConfig :: ResourceConfigProperty
..}
instance Property "ResourceConfig" Integration where
  type PropertyType "ResourceConfig" Integration = ResourceConfigProperty
  set :: PropertyType "ResourceConfig" Integration
-> Integration -> Integration
set PropertyType "ResourceConfig" Integration
newValue Integration {()
Value Text
ResourceConfigProperty
haddock_workaround_ :: Integration -> ()
integrationName :: Integration -> Value Text
integrationType :: Integration -> Value Text
resourceConfig :: Integration -> ResourceConfigProperty
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
resourceConfig :: ResourceConfigProperty
..}
    = Integration {resourceConfig :: ResourceConfigProperty
resourceConfig = PropertyType "ResourceConfig" Integration
ResourceConfigProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
haddock_workaround_ :: ()
integrationName :: Value Text
integrationType :: Value Text
..}