module Stratosphere.Greengrass.ConnectorDefinitionVersion (
module Exports, ConnectorDefinitionVersion(..),
mkConnectorDefinitionVersion
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Greengrass.ConnectorDefinitionVersion.ConnectorProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ConnectorDefinitionVersion
=
ConnectorDefinitionVersion {ConnectorDefinitionVersion -> ()
haddock_workaround_ :: (),
ConnectorDefinitionVersion -> Value Text
connectorDefinitionId :: (Value Prelude.Text),
ConnectorDefinitionVersion -> [ConnectorProperty]
connectors :: [ConnectorProperty]}
deriving stock (ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool
(ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool)
-> (ConnectorDefinitionVersion
-> ConnectorDefinitionVersion -> Bool)
-> Eq ConnectorDefinitionVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool
== :: ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool
$c/= :: ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool
/= :: ConnectorDefinitionVersion -> ConnectorDefinitionVersion -> Bool
Prelude.Eq, Int -> ConnectorDefinitionVersion -> ShowS
[ConnectorDefinitionVersion] -> ShowS
ConnectorDefinitionVersion -> String
(Int -> ConnectorDefinitionVersion -> ShowS)
-> (ConnectorDefinitionVersion -> String)
-> ([ConnectorDefinitionVersion] -> ShowS)
-> Show ConnectorDefinitionVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectorDefinitionVersion -> ShowS
showsPrec :: Int -> ConnectorDefinitionVersion -> ShowS
$cshow :: ConnectorDefinitionVersion -> String
show :: ConnectorDefinitionVersion -> String
$cshowList :: [ConnectorDefinitionVersion] -> ShowS
showList :: [ConnectorDefinitionVersion] -> ShowS
Prelude.Show)
mkConnectorDefinitionVersion ::
Value Prelude.Text
-> [ConnectorProperty] -> ConnectorDefinitionVersion
mkConnectorDefinitionVersion :: Value Text -> [ConnectorProperty] -> ConnectorDefinitionVersion
mkConnectorDefinitionVersion Value Text
connectorDefinitionId [ConnectorProperty]
connectors
= ConnectorDefinitionVersion
{haddock_workaround_ :: ()
haddock_workaround_ = (),
connectorDefinitionId :: Value Text
connectorDefinitionId = Value Text
connectorDefinitionId,
connectors :: [ConnectorProperty]
connectors = [ConnectorProperty]
connectors}
instance ToResourceProperties ConnectorDefinitionVersion where
toResourceProperties :: ConnectorDefinitionVersion -> ResourceProperties
toResourceProperties ConnectorDefinitionVersion {[ConnectorProperty]
()
Value Text
haddock_workaround_ :: ConnectorDefinitionVersion -> ()
connectorDefinitionId :: ConnectorDefinitionVersion -> Value Text
connectors :: ConnectorDefinitionVersion -> [ConnectorProperty]
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
connectors :: [ConnectorProperty]
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Greengrass::ConnectorDefinitionVersion",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"ConnectorDefinitionId"
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
connectorDefinitionId,
Key
"Connectors" Key -> [ConnectorProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ConnectorProperty]
connectors]}
instance JSON.ToJSON ConnectorDefinitionVersion where
toJSON :: ConnectorDefinitionVersion -> Value
toJSON ConnectorDefinitionVersion {[ConnectorProperty]
()
Value Text
haddock_workaround_ :: ConnectorDefinitionVersion -> ()
connectorDefinitionId :: ConnectorDefinitionVersion -> Value Text
connectors :: ConnectorDefinitionVersion -> [ConnectorProperty]
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
connectors :: [ConnectorProperty]
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"ConnectorDefinitionId" 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
connectorDefinitionId,
Key
"Connectors" Key -> [ConnectorProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ConnectorProperty]
connectors]
instance Property "ConnectorDefinitionId" ConnectorDefinitionVersion where
type PropertyType "ConnectorDefinitionId" ConnectorDefinitionVersion = Value Prelude.Text
set :: PropertyType "ConnectorDefinitionId" ConnectorDefinitionVersion
-> ConnectorDefinitionVersion -> ConnectorDefinitionVersion
set PropertyType "ConnectorDefinitionId" ConnectorDefinitionVersion
newValue ConnectorDefinitionVersion {[ConnectorProperty]
()
Value Text
haddock_workaround_ :: ConnectorDefinitionVersion -> ()
connectorDefinitionId :: ConnectorDefinitionVersion -> Value Text
connectors :: ConnectorDefinitionVersion -> [ConnectorProperty]
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
connectors :: [ConnectorProperty]
..}
= ConnectorDefinitionVersion {connectorDefinitionId :: Value Text
connectorDefinitionId = PropertyType "ConnectorDefinitionId" ConnectorDefinitionVersion
Value Text
newValue, [ConnectorProperty]
()
haddock_workaround_ :: ()
connectors :: [ConnectorProperty]
haddock_workaround_ :: ()
connectors :: [ConnectorProperty]
..}
instance Property "Connectors" ConnectorDefinitionVersion where
type PropertyType "Connectors" ConnectorDefinitionVersion = [ConnectorProperty]
set :: PropertyType "Connectors" ConnectorDefinitionVersion
-> ConnectorDefinitionVersion -> ConnectorDefinitionVersion
set PropertyType "Connectors" ConnectorDefinitionVersion
newValue ConnectorDefinitionVersion {[ConnectorProperty]
()
Value Text
haddock_workaround_ :: ConnectorDefinitionVersion -> ()
connectorDefinitionId :: ConnectorDefinitionVersion -> Value Text
connectors :: ConnectorDefinitionVersion -> [ConnectorProperty]
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
connectors :: [ConnectorProperty]
..}
= ConnectorDefinitionVersion {connectors :: [ConnectorProperty]
connectors = [ConnectorProperty]
PropertyType "Connectors" ConnectorDefinitionVersion
newValue, ()
Value Text
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
haddock_workaround_ :: ()
connectorDefinitionId :: Value Text
..}