module Stratosphere.ApiGateway.Resource (
        Resource(..), mkResource
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Resource
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-resource.html>
    Resource {Resource -> ()
haddock_workaround_ :: (),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-resource.html#cfn-apigateway-resource-parentid>
              Resource -> Value Text
parentId :: (Value Prelude.Text),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-resource.html#cfn-apigateway-resource-pathpart>
              Resource -> Value Text
pathPart :: (Value Prelude.Text),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-resource.html#cfn-apigateway-resource-restapiid>
              Resource -> Value Text
restApiId :: (Value Prelude.Text)}
  deriving stock (Resource -> Resource -> Bool
(Resource -> Resource -> Bool)
-> (Resource -> Resource -> Bool) -> Eq Resource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Resource -> Resource -> Bool
== :: Resource -> Resource -> Bool
$c/= :: Resource -> Resource -> Bool
/= :: Resource -> Resource -> Bool
Prelude.Eq, Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> String
(Int -> Resource -> ShowS)
-> (Resource -> String) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Resource -> ShowS
showsPrec :: Int -> Resource -> ShowS
$cshow :: Resource -> String
show :: Resource -> String
$cshowList :: [Resource] -> ShowS
showList :: [Resource] -> ShowS
Prelude.Show)
mkResource ::
  Value Prelude.Text
  -> Value Prelude.Text -> Value Prelude.Text -> Resource
mkResource :: Value Text -> Value Text -> Value Text -> Resource
mkResource Value Text
parentId Value Text
pathPart Value Text
restApiId
  = Resource
      {haddock_workaround_ :: ()
haddock_workaround_ = (), parentId :: Value Text
parentId = Value Text
parentId,
       pathPart :: Value Text
pathPart = Value Text
pathPart, restApiId :: Value Text
restApiId = Value Text
restApiId}
instance ToResourceProperties Resource where
  toResourceProperties :: Resource -> ResourceProperties
toResourceProperties Resource {()
Value Text
haddock_workaround_ :: Resource -> ()
parentId :: Resource -> Value Text
pathPart :: Resource -> Value Text
restApiId :: Resource -> Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
restApiId :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ApiGateway::Resource",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ParentId" 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
parentId,
                       Key
"PathPart" 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
pathPart, Key
"RestApiId" 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
restApiId]}
instance JSON.ToJSON Resource where
  toJSON :: Resource -> Value
toJSON Resource {()
Value Text
haddock_workaround_ :: Resource -> ()
parentId :: Resource -> Value Text
pathPart :: Resource -> Value Text
restApiId :: Resource -> Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
restApiId :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"ParentId" 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
parentId, Key
"PathPart" 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
pathPart,
         Key
"RestApiId" 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
restApiId]
instance Property "ParentId" Resource where
  type PropertyType "ParentId" Resource = Value Prelude.Text
  set :: PropertyType "ParentId" Resource -> Resource -> Resource
set PropertyType "ParentId" Resource
newValue Resource {()
Value Text
haddock_workaround_ :: Resource -> ()
parentId :: Resource -> Value Text
pathPart :: Resource -> Value Text
restApiId :: Resource -> Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
restApiId :: Value Text
..} = Resource {parentId :: Value Text
parentId = PropertyType "ParentId" Resource
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
pathPart :: Value Text
restApiId :: Value Text
haddock_workaround_ :: ()
pathPart :: Value Text
restApiId :: Value Text
..}
instance Property "PathPart" Resource where
  type PropertyType "PathPart" Resource = Value Prelude.Text
  set :: PropertyType "PathPart" Resource -> Resource -> Resource
set PropertyType "PathPart" Resource
newValue Resource {()
Value Text
haddock_workaround_ :: Resource -> ()
parentId :: Resource -> Value Text
pathPart :: Resource -> Value Text
restApiId :: Resource -> Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
restApiId :: Value Text
..} = Resource {pathPart :: Value Text
pathPart = PropertyType "PathPart" Resource
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
parentId :: Value Text
restApiId :: Value Text
haddock_workaround_ :: ()
parentId :: Value Text
restApiId :: Value Text
..}
instance Property "RestApiId" Resource where
  type PropertyType "RestApiId" Resource = Value Prelude.Text
  set :: PropertyType "RestApiId" Resource -> Resource -> Resource
set PropertyType "RestApiId" Resource
newValue Resource {()
Value Text
haddock_workaround_ :: Resource -> ()
parentId :: Resource -> Value Text
pathPart :: Resource -> Value Text
restApiId :: Resource -> Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
restApiId :: Value Text
..} = Resource {restApiId :: Value Text
restApiId = PropertyType "RestApiId" Resource
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
haddock_workaround_ :: ()
parentId :: Value Text
pathPart :: Value Text
..}