New server generator for Haskell/Yesod (#10193)

* Add a new server generator for Haskell/Yesod

* Fix missing locale
This commit is contained in:
Kenzo Yotsuya 2021-08-22 00:57:18 +09:00 committed by GitHub
parent aff4d2f4c2
commit 4e3a98cee4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
64 changed files with 3417 additions and 0 deletions

View File

@ -0,0 +1,6 @@
generatorName: haskell-yesod
outputDir: samples/server/petstore/haskell-yesod
inputSpec: modules/openapi-generator/src/test/resources/3_0/petstore.yaml
templateDir: modules/openapi-generator/src/main/resources/haskell-yesod
additionalProperties:
hideGenerationTimestamp: "true"

View File

@ -0,0 +1,187 @@
---
title: Config Options for haskell-yesod
sidebar_label: haskell-yesod
---
These options may be applied as additional-properties (cli) or configOptions (plugins). Refer to [configuration docs](https://openapi-generator.tech/docs/configuration) for more details.
| Option | Description | Values | Default |
| ------ | ----------- | ------ | ------- |
|allowUnicodeIdentifiers|boolean, toggles whether unicode identifiers are allowed in names or not, default is false| |false|
|apiModuleName|name of the API module (Default: generated from info.title or "API")| |null|
|disallowAdditionalPropertiesIfNotPresent|If false, the 'additionalProperties' implementation (set to true by default) is compliant with the OAS and JSON schema specifications. If true (default), keep the old (incorrect) behaviour that 'additionalProperties' is set to false by default.|<dl><dt>**false**</dt><dd>The 'additionalProperties' implementation is compliant with the OAS and JSON schema specifications.</dd><dt>**true**</dt><dd>Keep the old (incorrect) behaviour that 'additionalProperties' is set to false by default.</dd></dl>|true|
|ensureUniqueParams|Whether to ensure parameter names are unique in an operation (rename parameters that are not).| |true|
|legacyDiscriminatorBehavior|Set to false for generators with better support for discriminators. (Python, Java, Go, PowerShell, C#have this enabled by default).|<dl><dt>**true**</dt><dd>The mapping in the discriminator includes descendent schemas that allOf inherit from self and the discriminator mapping schemas in the OAS document.</dd><dt>**false**</dt><dd>The mapping in the discriminator includes any descendent schemas that allOf inherit from self, any oneOf schemas, any anyOf schemas, any x-discriminator-values, and the discriminator mapping schemas in the OAS document AND Codegen validates that oneOf and anyOf schemas contain the required discriminator and throws an error if the discriminator is missing.</dd></dl>|true|
|prependFormOrBodyParameters|Add form or body parameters to the beginning of the parameter list.| |false|
|projectName|name of the project (Default: generated from info.title or &quot;openapi-haskell-yesod-server&quot;)| |null|
|sortModelPropertiesByRequiredFlag|Sort model properties to place required parameters before optional parameters.| |true|
|sortParamsByRequiredFlag|Sort method arguments to place required parameters before optional parameters.| |true|
## IMPORT MAPPING
| Type/Alias | Imports |
| ---------- | ------- |
## INSTANTIATION TYPES
| Type/Alias | Instantiated By |
| ---------- | --------------- |
## LANGUAGE PRIMITIVES
<ul class="column-ul">
<li>Bool</li>
<li>Day</li>
<li>Double</li>
<li>Float</li>
<li>Int</li>
<li>Int64</li>
<li>Text</li>
<li>UTCTime</li>
</ul>
## RESERVED WORDS
<ul class="column-ul">
<li>as</li>
<li>case</li>
<li>class</li>
<li>data</li>
<li>default</li>
<li>deriving</li>
<li>do</li>
<li>else</li>
<li>family</li>
<li>forall</li>
<li>foreign</li>
<li>hiding</li>
<li>if</li>
<li>import</li>
<li>in</li>
<li>infix</li>
<li>infixl</li>
<li>infixr</li>
<li>instance</li>
<li>let</li>
<li>mdo</li>
<li>module</li>
<li>newtype</li>
<li>of</li>
<li>proc</li>
<li>qualified</li>
<li>rec</li>
<li>then</li>
<li>type</li>
<li>where</li>
</ul>
## FEATURE SET
### Client Modification Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|BasePath|✗|ToolingExtension
|Authorizations|✗|ToolingExtension
|UserAgent|✗|ToolingExtension
|MockServer|✗|ToolingExtension
### Data Type Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|Custom|✗|OAS2,OAS3
|Int32|✓|OAS2,OAS3
|Int64|✓|OAS2,OAS3
|Float|✓|OAS2,OAS3
|Double|✓|OAS2,OAS3
|Decimal|✓|ToolingExtension
|String|✓|OAS2,OAS3
|Byte|✓|OAS2,OAS3
|Binary|✓|OAS2,OAS3
|Boolean|✓|OAS2,OAS3
|Date|✓|OAS2,OAS3
|DateTime|✓|OAS2,OAS3
|Password|✓|OAS2,OAS3
|File|✓|OAS2
|Array|✓|OAS2,OAS3
|Maps|✓|ToolingExtension
|CollectionFormat|✓|OAS2
|CollectionFormatMulti|✓|OAS2
|Enum|✓|OAS2,OAS3
|ArrayOfEnum|✓|ToolingExtension
|ArrayOfModel|✓|ToolingExtension
|ArrayOfCollectionOfPrimitives|✓|ToolingExtension
|ArrayOfCollectionOfModel|✓|ToolingExtension
|ArrayOfCollectionOfEnum|✓|ToolingExtension
|MapOfEnum|✓|ToolingExtension
|MapOfModel|✓|ToolingExtension
|MapOfCollectionOfPrimitives|✓|ToolingExtension
|MapOfCollectionOfModel|✓|ToolingExtension
|MapOfCollectionOfEnum|✓|ToolingExtension
### Documentation Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|Readme|✓|ToolingExtension
|Model|✓|ToolingExtension
|Api|✓|ToolingExtension
### Global Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|Host|✓|OAS2,OAS3
|BasePath|✓|OAS2,OAS3
|Info|✓|OAS2,OAS3
|Schemes|✗|OAS2,OAS3
|PartialSchemes|✓|OAS2,OAS3
|Consumes|✓|OAS2
|Produces|✓|OAS2
|ExternalDocumentation|✓|OAS2,OAS3
|Examples|✓|OAS2,OAS3
|XMLStructureDefinitions|✗|OAS2,OAS3
|MultiServer|✗|OAS3
|ParameterizedServer|✗|OAS3
|ParameterStyling|✗|OAS3
|Callbacks|✗|OAS3
|LinkObjects|✗|OAS3
### Parameter Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|Path|✓|OAS2,OAS3
|Query|✓|OAS2,OAS3
|Header|✓|OAS2,OAS3
|Body|✓|OAS2
|FormUnencoded|✓|OAS2
|FormMultipart|✓|OAS2
|Cookie|✓|OAS3
### Schema Support Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|Simple|✓|OAS2,OAS3
|Composite|✓|OAS2,OAS3
|Polymorphism|✗|OAS2,OAS3
|Union|✗|OAS3
### Security Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|BasicAuth|✓|OAS2,OAS3
|ApiKey|✓|OAS2,OAS3
|OpenIDConnect|✗|OAS3
|BearerToken|✗|OAS3
|OAuth2_Implicit|✓|OAS2,OAS3
|OAuth2_Password|✗|OAS2,OAS3
|OAuth2_ClientCredentials|✗|OAS2,OAS3
|OAuth2_AuthorizationCode|✗|OAS2,OAS3
### Wire Format Feature
| Name | Supported | Defined By |
| ---- | --------- | ---------- |
|JSON|✓|OAS2,OAS3
|XML|✗|OAS2,OAS3
|PROTOBUF|✗|ToolingExtension
|Custom|✗|OAS2,OAS3

View File

@ -0,0 +1,616 @@
package org.openapitools.codegen.languages;
import org.openapitools.codegen.*;
import org.openapitools.codegen.meta.features.*;
import org.openapitools.codegen.utils.ModelUtils;
import io.swagger.models.properties.ArrayProperty;
import io.swagger.models.properties.MapProperty;
import io.swagger.models.properties.Property;
import io.swagger.models.parameters.Parameter;
import io.swagger.v3.oas.models.OpenAPI;
import io.swagger.v3.oas.models.Operation;
import io.swagger.v3.oas.models.info.Info;
import io.swagger.v3.oas.models.media.ArraySchema;
import io.swagger.v3.oas.models.media.Schema;
import io.swagger.v3.oas.models.servers.Server;
import java.io.File;
import java.io.IOException;
import java.util.*;
import java.util.regex.Pattern;
import org.apache.commons.io.FilenameUtils;
import org.apache.commons.lang3.StringUtils;
import org.slf4j.Logger;
import org.slf4j.LoggerFactory;
import static org.openapitools.codegen.utils.StringUtils.*;
public class HaskellYesodServerCodegen extends DefaultCodegen implements CodegenConfig {
public static final String PROJECT_NAME = "projectName";
public static final String API_MODULE_NAME = "apiModuleName";
private static final Pattern LEADING_UNDERSCORE = Pattern.compile("^_+");
static final Logger LOGGER = LoggerFactory.getLogger(HaskellYesodServerCodegen.class);
protected String projectName;
protected String apiModuleName;
public CodegenType getTag() {
return CodegenType.SERVER;
}
public String getName() {
return "haskell-yesod";
}
public String getHelp() {
return "Generates a haskell-yesod server.";
}
public String getProjectName() {
return projectName;
}
public void setProjectName(String projectName) {
this.projectName = projectName;
}
public String getApiModuleName() {
return apiModuleName;
}
public void setApiModuleName(String apiModuleName) {
this.apiModuleName = apiModuleName;
}
public HaskellYesodServerCodegen() {
super();
modifyFeatureSet(features -> features
.includeDocumentationFeatures(DocumentationFeature.Readme)
.wireFormatFeatures(EnumSet.of(WireFormatFeature.JSON))
.securityFeatures(EnumSet.of(
SecurityFeature.BasicAuth,
SecurityFeature.ApiKey,
SecurityFeature.OAuth2_Implicit
))
.excludeGlobalFeatures(
GlobalFeature.Callbacks
)
.excludeSchemaSupportFeatures(
SchemaSupportFeature.Polymorphism
)
);
// override the mapping to keep the original mapping in Haskell
specialCharReplacements.put("-", "Dash");
specialCharReplacements.put(">", "GreaterThan");
specialCharReplacements.put("<", "LessThan");
// backslash and double quote need double the escapement for both Java and Haskell
specialCharReplacements.remove("\\");
specialCharReplacements.remove("\"");
specialCharReplacements.put("\\\\", "Back_Slash");
specialCharReplacements.put("\\\"", "Double_Quote");
outputFolder = "generated-code" + File.separator + "haskell-yesod";
apiTemplateFiles.put("api.mustache", ".hs");
apiTestTemplateFiles.put("api_test.mustache", ".hs");
embeddedTemplateDir = templateDir = "haskell-yesod";
apiNameSuffix = "";
// Haskell keywords and reserved function names, taken mostly from https://wiki.haskell.org/Keywords
setReservedWordsLowerCase(
Arrays.asList(
// Keywords
"as", "case", "of",
"class", "data", "family",
"default", "deriving",
"do", "forall", "foreign", "hiding",
"if", "then", "else",
"import", "infix", "infixl", "infixr",
"instance", "let", "in",
"mdo", "module", "newtype",
"proc", "qualified", "rec",
"type", "where"
)
);
languageSpecificPrimitives = new HashSet<String>(
Arrays.asList(
"Bool",
"Int",
"Int64",
"Float",
"Double",
"Text",
"Day",
"UTCTime"
)
);
typeMapping.clear();
typeMapping.put("boolean", "Bool"); // type:boolean
typeMapping.put("integer", "Int"); // type:integer+format:int32, type:integer
typeMapping.put("long", "Int64"); // type:integer+format:int64
typeMapping.put("number", "Double"); // type:number
typeMapping.put("float", "Float"); // type:number+format:float
typeMapping.put("double", "Double"); // type:number+format:double
typeMapping.put("string", "Text"); // type:string
typeMapping.put("date", "Day"); // type:string+format:date
typeMapping.put("DateTime", "UTCTime"); // type:string+format:date-time
typeMapping.put("decimal", "Text"); // type:string+format:number
typeMapping.put("URI", "Text"); // type:string+format:uri
typeMapping.put("UUID", "Text"); // type:string+format:uuid
typeMapping.put("ByteArray", "Text"); // type:string+format:byte
typeMapping.put("binary", "Text"); // type:string+format:binary
typeMapping.put("file", "Text"); // type:string+format:binary(OAS3), type:file(OAS2)
typeMapping.put("AnyType", "Value"); // type not specified
// See getTypeDeclaration() for the followings.
// typeMapping.put("array", "List"); // type:array (ArraySchema)
// typeMapping.put("set", "List"); // type:array+uniqueItems:true (ArraySchema)
// typeMapping.put("map", "Map.Map"); // type:object+additionalProperties:true/<object> (MapSchema)
// type:object is defined as a separate data type, so the type mapping is not required.
// typeMapping.put("object", "Value"); // type:object
importMapping.clear();
cliOptions.add(new CliOption(PROJECT_NAME,
"name of the project (Default: generated from info.title or \"openapi-haskell-yesod-server\")"));
cliOptions.add(new CliOption(API_MODULE_NAME,
"name of the API module (Default: generated from info.title or \"API\")"));
}
@Override
public String apiFileFolder() {
return outputFolder + File.separator + "src" + File.separator + "Handler";
}
@Override
public String apiTestFileFolder() {
return outputFolder + File.separator + "test" + File.separator + "Handler";
}
@Override
public String toApiTestFilename(String name) {
return toApiName(name) + "Spec";
}
@Override
public void processOpts() {
super.processOpts();
if (StringUtils.isEmpty(System.getenv("HASKELL_POST_PROCESS_FILE"))) {
LOGGER.info("Hint: Environment variable HASKELL_POST_PROCESS_FILE not defined so the Haskell code may not be properly formatted. To define it, try 'export HASKELL_POST_PROCESS_FILE=\"$HOME/.local/bin/hfmt -w\"' (Linux/Mac)");
}
if (additionalProperties.containsKey(PROJECT_NAME)) {
this.setProjectName((String) additionalProperties.get(PROJECT_NAME));
}
if (additionalProperties.containsKey(API_MODULE_NAME)) {
this.setApiModuleName((String) additionalProperties.get(API_MODULE_NAME));
}
}
/**
* Escapes a reserved word as defined in the `reservedWords` array. Handle escaping
* those terms here. This logic is only called if a variable matches the reserved words
*
* @return the escaped term
*/
@Override
public String escapeReservedWord(String name) {
if (this.reservedWordsMappings().containsKey(name)) {
return this.reservedWordsMappings().get(name);
}
return "_" + name;
}
@Override
public void preprocessOpenAPI(OpenAPI openAPI) {
super.preprocessOpenAPI(openAPI);
if (openAPI.getInfo() != null) {
Info info = openAPI.getInfo();
if (StringUtils.isBlank(projectName) && info.getTitle() != null) {
// when projectName is not specified, generate it from info.title
projectName = dashize(sanitizeName(info.getTitle()));
}
if (StringUtils.isBlank(apiModuleName) && info.getTitle() != null) {
// when apiModuleName is not specified, generate it from info.title
apiModuleName = camelize(sanitizeName(info.getTitle()));
}
}
// default values
if (StringUtils.isBlank(projectName)) {
projectName = "openapi-haskell-yesod-server";
}
if (StringUtils.isBlank(apiModuleName)) {
apiModuleName = "API";
}
additionalProperties.put(PROJECT_NAME, projectName);
additionalProperties.put(API_MODULE_NAME, apiModuleName);
supportingFiles.add(new SupportingFile("README.mustache", "", "README.md"));
supportingFiles.add(new SupportingFile("app/DevelMain.mustache", "app", "DevelMain.hs"));
supportingFiles.add(new SupportingFile("app/devel.mustache", "app", "devel.hs"));
supportingFiles.add(new SupportingFile("app/main.hs", "app", "main.hs"));
supportingFiles.add(new SupportingFile("config/keter.mustache", "config", "keter.yml"));
supportingFiles.add(new SupportingFile("config/routes.mustache", "config", "routes.yesodroutes"));
supportingFiles.add(new SupportingFile("config/settings.yml", "config", "settings.yml"));
supportingFiles.add(new SupportingFile("config/test-settings.yml", "config", "test-settings.yml"));
supportingFiles.add(new SupportingFile("dir-locals.el", "", ".dir-locals.el"));
supportingFiles.add(new SupportingFile("gitignore.mustache", "", ".gitignore"));
supportingFiles.add(new SupportingFile("package.mustache", "", "package.yaml"));
supportingFiles.add(new SupportingFile("src/API/Types.mustache", "src" + File.separator + apiModuleName, "Types.hs"));
supportingFiles.add(new SupportingFile("src/Application.mustache", "src", "Application.hs"));
supportingFiles.add(new SupportingFile("src/Error.hs", "src", "Error.hs"));
supportingFiles.add(new SupportingFile("src/Foundation.hs", "src", "Foundation.hs"));
supportingFiles.add(new SupportingFile("src/Import/NoFoundation.mustache", "src" + File.separator + "Import", "NoFoundation.hs"));
supportingFiles.add(new SupportingFile("src/Import.hs", "src", "Import.hs"));
supportingFiles.add(new SupportingFile("src/Settings/StaticFiles.hs", "src" + File.separator + "Settings", "StaticFiles.hs"));
supportingFiles.add(new SupportingFile("src/Settings.hs", "src", "Settings.hs"));
supportingFiles.add(new SupportingFile("stack.yaml", "", "stack.yaml"));
supportingFiles.add(new SupportingFile("static/gitkeep", "static", ".gitkeep"));
supportingFiles.add(new SupportingFile("test/Spec.hs", "test", "Spec.hs"));
supportingFiles.add(new SupportingFile("test/TestImport.hs", "test", "TestImport.hs"));
List<Map<String, Object>> replacements = new ArrayList<>();
Object[] replacementChars = specialCharReplacements.keySet().toArray();
for (Object replacementChar : replacementChars) {
String c = (String) replacementChar;
Map<String, Object> o = new HashMap<>();
o.put("char", c);
o.put("replacement", "'" + specialCharReplacements.get(c));
replacements.add(o);
}
additionalProperties.put("specialCharReplacements", replacements);
}
/**
* Optional - type declaration. This is a String which is used by the templates to instantiate your
* types. There is typically special handling for different property types
*
* @return a string value used as the `dataType` field for model templates, `returnType` for api templates
*/
@Override
public String getTypeDeclaration(Schema p) {
if (ModelUtils.isArraySchema(p)) {
ArraySchema ap = (ArraySchema) p;
Schema inner = ap.getItems();
return "[" + getTypeDeclaration(inner) + "]";
} else if (ModelUtils.isMapSchema(p)) {
Schema inner = getAdditionalProperties(p);
return "(Map.Map String " + getTypeDeclaration(inner) + ")";
}
return fixModelChars(super.getTypeDeclaration(p));
}
/**
* Optional - OpenAPI type conversion. This is used to map OpenAPI types in a `Schema` into
* either language specific types via `typeMapping` or into complex models if there is not a mapping.
*
* @return a string value of the type or complex model for this property
*/
@Override
public String getSchemaType(Schema p) {
String schemaType = super.getSchemaType(p);
LOGGER.debug("debugging OpenAPI type: {}, {} => {}", p.getType(), p.getFormat(), schemaType);
String type = null;
if (typeMapping.containsKey(schemaType)) {
type = typeMapping.get(schemaType);
return type;
//if (languageSpecificPrimitives.contains(type))
// return toModelName(type);
} else if (typeMapping.containsValue(schemaType)) {
// TODO what's this case for?
type = schemaType + "_";
} else {
type = schemaType;
}
// it's a model
return toModelName(type);
}
@Override
public String toInstantiationType(Schema p) {
if (ModelUtils.isMapSchema(p)) {
Schema additionalProperties2 = getAdditionalProperties(p);
String type = additionalProperties2.getType();
if (null == type) {
LOGGER.error("No Type defined for Additional Property {}\n\tIn Property: {}", additionalProperties2, p);
}
String inner = getSchemaType(additionalProperties2);
return "(Map.Map Text " + inner + ")";
} else if (ModelUtils.isArraySchema(p)) {
ArraySchema ap = (ArraySchema) p;
String inner = getSchemaType(ap.getItems());
// Return only the inner type; the wrapping with QueryList is done
// somewhere else, where we have access to the collection format.
return inner;
} else {
return null;
}
}
private List<String> pathToComponents(String path, List<CodegenParameter> pathParams) {
// Map the capture params by their names.
HashMap<String, String> captureTypes = new HashMap<String, String>();
for (CodegenParameter param : pathParams) {
captureTypes.put(param.baseName, param.dataType);
}
// Cut off the leading slash, if it is present.
if (path.startsWith("/")) {
path = path.substring(1);
}
// Convert the path into a list of yesod path components.
List<String> components = new ArrayList<String>();
for (String piece : path.split("/")) {
if (piece.startsWith("{") && piece.endsWith("}")) {
String name = piece.substring(1, piece.length() - 1);
components.add("#" + captureTypes.get(name));
} else {
components.add(piece);
}
}
return components;
}
private String pathToYesodPath(String path, List<CodegenParameter> pathParams) {
return "/" + String.join("/", pathToComponents(path, pathParams));
}
private String pathToYesodResource(String path, List<CodegenParameter> pathParams) {
String resource = "";
for (String component : pathToComponents(path, pathParams)) {
if (component.startsWith("#")) {
resource += "By" + camelize(component.substring(1));
} else {
resource += camelize(component);
}
}
if (resource.isEmpty()) {
resource = camelize(apiModuleName) + "Home";
}
resource += "R";
return resource;
}
@Override
public CodegenOperation fromOperation(String resourcePath, String httpMethod, Operation operation, List<Server> servers) {
CodegenOperation op = super.fromOperation(resourcePath, httpMethod, operation, servers);
String path = pathToYesodPath(op.path, op.pathParams);
String resource = pathToYesodResource(op.path, op.pathParams);
List <Map<String, Object>> routes = (List <Map<String, Object>>) additionalProperties.get("routes");
if (routes == null) {
routes = new ArrayList<Map<String, Object>>();
additionalProperties.put("routes", routes);
}
// https://www.yesodweb.com/book/routing-and-handlers#routing-and-handlers_overlap_checking
if (hasOverlappedPath(path, routes)) {
path = "!" + path;
}
Boolean found = false;
for (Map<String, Object> route : routes) {
if (path.equals(route.get("path"))) {
List<String> methods = (List<String>) route.get("methods");
methods.add(op.httpMethod);
found = true;
break;
}
}
if (!found) {
Map<String, Object> route = new HashMap<String, Object>();
route.put("path", path);
route.put("resource", resource);
List<String> methods = new ArrayList<String>();
methods.add(op.httpMethod);
route.put("methods", methods);
routes.add(route);
}
// values used in api.mustache/api_test.mustache
String handler = httpMethod.toLowerCase(Locale.ROOT) + resource;
String paramIndent = StringUtils.repeat(" ", handler.length());
op.vendorExtensions.put("x-handler", handler);
op.vendorExtensions.put("x-param-indent", paramIndent);
op.vendorExtensions.put("x-resource", resource);
op.vendorExtensions.put("x-is-get-or-post", op.httpMethod.equals("GET") || op.httpMethod.equals("POST"));
for (CodegenParameter param : op.pathParams) {
param.vendorExtensions.put("x-handler", handler);
param.vendorExtensions.put("x-param-indent", paramIndent);
param.vendorExtensions.put("x-test-value", getParameterTestValue(param));
}
return op;
}
public Boolean hasOverlappedPath(String path, List <Map<String, Object>> routes) {
for (Map<String, Object> route : routes) {
String processedPath = (String) route.get("path");
if (processedPath.startsWith("!")) {
continue;
}
if (isOverlappedPath(path, processedPath)) {
return true;
}
}
return false;
}
public Boolean isOverlappedPath(String pathA, String pathB) {
if (pathA.equals(pathB)) {
return false;
}
String[] componentsA = pathA.split("/");
String[] componentsB = pathB.split("/");
if (componentsA.length != componentsB.length) {
return false;
}
for (int i = 0; i < componentsA.length; i++) {
if (componentsA[i].equals(componentsB[i])) {
continue;
} else if (componentsA[i].startsWith("#") || componentsB[i].startsWith("#")) {
continue;
} else {
return false;
}
}
return true;
}
private String getParameterTestValue(CodegenParameter codegenParameter) {
if (Boolean.TRUE.equals(codegenParameter.isBoolean)) {
return codegenParameter.example; // "true";
} else if (Boolean.TRUE.equals(codegenParameter.isLong)) {
return codegenParameter.example; // "789";
} else if (Boolean.TRUE.equals(codegenParameter.isInteger)) {
return codegenParameter.example; // "56";
} else if (Boolean.TRUE.equals(codegenParameter.isFloat)) {
return codegenParameter.example; // "3.4";
} else if (Boolean.TRUE.equals(codegenParameter.isDouble)) {
return codegenParameter.example; // "1.2";
} else if (Boolean.TRUE.equals(codegenParameter.isNumber)) {
return codegenParameter.example; // "8.14";
} else if (Boolean.TRUE.equals(codegenParameter.isBinary)) {
return "\"" + codegenParameter.example + "\""; // "BINARY_DATA_HERE";
} else if (Boolean.TRUE.equals(codegenParameter.isByteArray)) {
return "\"" + codegenParameter.example + "\""; // "BYTE_ARRAY_DATA_HERE";
} else if (Boolean.TRUE.equals(codegenParameter.isFile)) {
return "\"" + codegenParameter.example + "\""; // "/path/to/file.txt";
} else if (Boolean.TRUE.equals(codegenParameter.isDate)) {
return "\"" + codegenParameter.example + "\""; // "2013-10-20";
} else if (Boolean.TRUE.equals(codegenParameter.isDateTime)) {
return "\"" + codegenParameter.example + "\""; // "2013-10-20T19:20:30+01:00";
} else if (Boolean.TRUE.equals(codegenParameter.isUuid)) {
return "\"" + codegenParameter.example + "\""; // "38400000-8cf0-11bd-b23e-10b96e4ef00d";
} else if (Boolean.TRUE.equals(codegenParameter.isUri)) {
return "\"" + codegenParameter.example + "\""; // "https://openapi-generator.tech";
} else if (Boolean.TRUE.equals(codegenParameter.isString)) {
return "\"" + codegenParameter.example + "\""; // codegenParameter.paramName + "_example";
} else if (Boolean.TRUE.equals(codegenParameter.isFreeFormObject)) {
return "\"" + codegenParameter.example + "\""; // "Object";
} else {
return "unknown";
}
}
private String fixOperatorChars(String string) {
StringBuilder sb = new StringBuilder();
String name = string;
//Check if it is a reserved word, in which case the underscore is added when property name is generated.
if (string.startsWith("_")) {
if (reservedWords.contains(string.substring(1, string.length()))) {
name = string.substring(1, string.length());
} else if (reservedWordsMappings.containsValue(string)) {
name = LEADING_UNDERSCORE.matcher(string).replaceFirst("");
}
}
for (char c : name.toCharArray()) {
String cString = String.valueOf(c);
if (specialCharReplacements.containsKey(cString)) {
sb.append("'");
sb.append(specialCharReplacements.get(cString));
} else {
sb.append(c);
}
}
return sb.toString();
}
// Remove characters from a string that do not belong in a model classname
private String fixModelChars(String string) {
return string.replace(".", "").replace("-", "");
}
// Override fromModel to create the appropriate model namings
@Override
public CodegenModel fromModel(String name, Schema mod) {
CodegenModel model = super.fromModel(name, mod);
// setGenerateToSchema(model);
// Clean up the class name to remove invalid characters
model.classname = fixModelChars(model.classname);
if (typeMapping.containsValue(model.classname)) {
model.classname += "_";
}
// From the model name, compute the prefix for the fields.
String prefix = camelize(model.classname, true);
for (CodegenProperty prop : model.vars) {
prop.name = toVarName(prefix + camelize(fixOperatorChars(prop.name)));
}
// Create newtypes for things with non-object types
String dataOrNewtype = "data";
if (!"object".equals(model.dataType) && typeMapping.containsKey(model.dataType)) {
String newtype = typeMapping.get(model.dataType);
// note; newtype is a single lowercase word in Haskell (not separated by hyphen)
model.vendorExtensions.put("x-custom-newtype", newtype);
}
// Provide the prefix as a vendor extension, so that it can be used in the ToJSON and FromJSON instances.
model.vendorExtensions.put("x-prefix", prefix);
model.vendorExtensions.put("x-data", dataOrNewtype);
return model;
}
@Override
public String escapeQuotationMark(String input) {
// remove " to avoid code injection
return input.replace("\"", "");
}
@Override
public String escapeUnsafeCharacters(String input) {
return input.replace("{-", "{_-").replace("-}", "-_}");
}
@Override
public void postProcessFile(File file, String fileType) {
if (file == null) {
return;
}
String haskellPostProcessFile = System.getenv("HASKELL_POST_PROCESS_FILE");
if (StringUtils.isEmpty(haskellPostProcessFile)) {
return; // skip if HASKELL_POST_PROCESS_FILE env variable is not defined
}
// only process files with hs extension
if ("hs".equals(FilenameUtils.getExtension(file.toString()))) {
String command = haskellPostProcessFile + " " + file.toString();
try {
Process p = Runtime.getRuntime().exec(command);
int exitValue = p.waitFor();
if (exitValue != 0) {
LOGGER.error("Error running the command ({}). Exit value: {}", command, exitValue);
} else {
LOGGER.info("Successfully executed: {}", command);
}
} catch (InterruptedException | IOException e) {
LOGGER.error("Error running the command ({}). Exception: {}", command, e.getMessage());
// Restore interrupted state
Thread.currentThread().interrupt();
}
}
}
}

View File

@ -52,6 +52,7 @@ org.openapitools.codegen.languages.KotlinVertxServerCodegen
org.openapitools.codegen.languages.KtormSchemaCodegen
org.openapitools.codegen.languages.HaskellHttpClientCodegen
org.openapitools.codegen.languages.HaskellServantCodegen
org.openapitools.codegen.languages.HaskellYesodServerCodegen
org.openapitools.codegen.languages.JavaClientCodegen
org.openapitools.codegen.languages.JavaCXFClientCodegen
org.openapitools.codegen.languages.JavaInflectorServerCodegen

View File

@ -0,0 +1,43 @@
## Haskell Setup
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
2. Install the `yesod` command line tool: `stack install yesod-bin --install-ghc`
3. Build libraries: `stack build`
If you have trouble, refer to the [Yesod Quickstart guide](https://www.yesodweb.com/page/quickstart) for additional detail.
## Development
Start a development server with:
```
stack exec -- yesod devel
```
As your code changes, your site will be automatically recompiled and redeployed to localhost.
## Tests
```
stack test --flag {{projectName}}:library-only --flag {{projectName}}:dev
```
(Because `yesod devel` passes the `library-only` and `dev` flags, matching those flags means you don't need to recompile between tests and development, and it disables optimization to speed up your test compile times).
## Documentation
* Read the [Yesod Book](https://www.yesodweb.com/book) online for free
* Check [Stackage](http://stackage.org/) for documentation on the packages in your LTS Haskell version, or [search it using Hoogle](https://www.stackage.org/lts/hoogle?q=). Tip: Your LTS version is in your `stack.yaml` file.
* For local documentation, use:
* `stack haddock --open` to generate Haddock documentation for your dependencies, and open that documentation in a browser
* `stack hoogle <function, module or type signature>` to generate a Hoogle database and search for your query
* The [Yesod cookbook](https://github.com/yesodweb/yesod-cookbook) has sample code for various needs
## Getting Help
* Ask questions on [Stack Overflow, using the Yesod or Haskell tags](https://stackoverflow.com/questions/tagged/yesod+haskell)
* Ask the [Yesod Google Group](https://groups.google.com/forum/#!forum/yesodweb)
* There are several chatrooms you can ask for help:
* For IRC, try Freenode#yesod and Freenode#haskell
* [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels.

View File

@ -0,0 +1,34 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Handler.{{classname}} where
import Import
{{#operations}}
{{#operation}}
-- | {{summary}}
--
{{#notes}}
-- {{notes}}
{{/notes}}
{{#nickname}}
-- operationId: {{nickname}}
{{/nickname}}
{{#hasPathParams}}
{{#pathParams}}
{{#-first}}
{{vendorExtensions.x-handler}} :: {{dataType}} -- ^ {{description}}
{{/-first}}
{{^-first}}
{{vendorExtensions.x-param-indent}} -> {{dataType}} -- ^ {{description}}
{{/-first}}
{{/pathParams}}
{{vendorExtensions.x-param-indent}} -> Handler Value
{{/hasPathParams}}
{{^hasPathParams}}
{{vendorExtensions.x-handler}} :: Handler Value
{{/hasPathParams}}
{{vendorExtensions.x-handler}}{{#pathParams}} {{paramName}}{{/pathParams}} = notImplemented
{{/operation}}
{{/operations}}

View File

@ -0,0 +1,33 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.{{classname}}Spec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
{{#operations}}
{{#operation}}
describe "{{vendorExtensions.x-handler}}" $
it "returns 501 Not Implemented" $ do
{{#vendorExtensions.x-is-get-or-post}}
{{#hasPathParams}}
{{#lambda.lowercase}}{{httpMethod}}{{/lambda.lowercase}} $ {{vendorExtensions.x-resource}}{{#pathParams}} {{{vendorExtensions.x-test-value}}}{{/pathParams}}
{{/hasPathParams}}
{{^hasPathParams}}
{{#lambda.lowercase}}{{httpMethod}}{{/lambda.lowercase}} {{vendorExtensions.x-resource}}
{{/hasPathParams}}
{{/vendorExtensions.x-is-get-or-post}}
{{^vendorExtensions.x-is-get-or-post}}
{{#hasPathParams}}
performMethod "{{httpMethod}}" $ {{vendorExtensions.x-resource}}{{#pathParams}} {{{vendorExtensions.x-test-value}}}{{/pathParams}}
{{/hasPathParams}}
{{^hasPathParams}}
performMethod "{{httpMethod}}" {{vendorExtensions.x-resource}}
{{/hasPathParams}}
{{/vendorExtensions.x-is-get-or-post}}
statusIs 501
{{/operation}}
{{/operations}}

View File

@ -0,0 +1,105 @@
-- | Running your app inside GHCi.
--
-- This option provides significantly faster code reload compared to
-- @yesod devel@. However, you do not get automatic code reload
-- (which may be a benefit, depending on your perspective). To use this:
--
-- 1. Start up GHCi
--
-- $ stack ghci {{projectName}}:lib --no-load --work-dir .stack-work-devel
--
-- 2. Load this module
--
-- > :l app/DevelMain.hs
--
-- 3. Run @update@
--
-- > DevelMain.update
--
-- 4. Your app should now be running, you can connect at http://localhost:3000
--
-- 5. Make changes to your code
--
-- 6. After saving your changes, reload by running:
--
-- > :r
-- > DevelMain.update
--
-- You can also call @DevelMain.shutdown@ to stop the app
--
-- There is more information about this approach,
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
--
-- WARNING: GHCi does not notice changes made to your template files.
-- If you change a template, you'll need to either exit GHCi and reload,
-- or manually @touch@ another Haskell module.
module DevelMain where
import Prelude
import Application (getApplicationRepl, shutdownApp)
import Control.Monad ((>=>))
import Control.Concurrent
import Data.IORef
import Foreign.Store
import Network.Wai.Handler.Warp
import GHC.Word
-- | Start or restart the server.
-- newStore is from foreign-store.
-- A Store holds onto some data across ghci reloads
update :: IO ()
update = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
Just tidStore -> restartAppInNewThread tidStore
where
doneStore :: Store (MVar ())
doneStore = Store 0
-- shut the server down with killThread and wait for the done signal
restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
-- | Start the server in a separate thread.
start :: MVar () -- ^ Written to when the thread is killed.
-> IO ThreadId
start done = do
(port, site, app) <- getApplicationRepl
forkFinally
(runSettings (setPort port defaultSettings) app)
-- Note that this implies concurrency
-- between shutdownApp and the next app that is starting.
-- Normally this should be fine
(\_ -> putMVar done () >> shutdownApp site)
-- | kill the server
shutdown :: IO ()
shutdown = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> putStrLn "no Yesod app running"
Just tidStore -> do
withStore tidStore $ readIORef >=> killThread
putStrLn "Yesod app is shutdown"
tidStoreNum :: Word32
tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref

View File

@ -0,0 +1,6 @@
{-# LANGUAGE PackageImports #-}
import "{{projectName}}" Application (develMain)
import Prelude (IO)
main :: IO ()
main = develMain

View File

@ -0,0 +1,5 @@
import Prelude (IO)
import Application (appMain)
main :: IO ()
main = appMain

View File

@ -0,0 +1,70 @@
# After you've edited this file, remove the following line to allow
# `yesod keter` to build your bundle.
user-edited: false
# A Keter app is composed of 1 or more stanzas. The main stanza will define our
# web application. See the Keter documentation for more information on
# available stanzas.
stanzas:
# Your Yesod application.
- type: webapp
# Name of your executable. You are unlikely to need to change this.
# Note that all file paths are relative to the keter.yml file.
#
# The path given is for Stack projects. If you're still using cabal, change
# to
# exec: ../dist/build/{{projectName}}/{{projectName}}
exec: ../dist/bin/{{projectName}}
# Command line options passed to your application.
args: []
hosts:
# You can specify one or more hostnames for your application to respond
# to. The primary hostname will be used for generating your application
# root.
- www.{{projectName}}.com
# Enable to force Keter to redirect to https
# Can be added to any stanza
requires-secure: false
# Static files.
- type: static-files
hosts:
- static.{{projectName}}.com
root: ../static
# Uncomment to turn on directory listings.
# directory-listing: true
# Redirect plain domain name to www.
- type: redirect
hosts:
- {{projectName}}.com
actions:
- host: www.{{projectName}}.com
# secure: false
# port: 80
# Uncomment to switch to a non-permanent redirect.
# status: 303
# Use the following to automatically copy your bundle upon creation via `yesod
# keter`. Uses `scp` internally, so you can set it to a remote destination
# copy-to: user@host:/opt/keter/incoming/
# You can pass arguments to `scp` used above. This example limits bandwidth to
# 1024 Kbit/s and uses port 2222 instead of the default 22
# copy-to-args:
# - "-l 1024"
# - "-P 2222"
# If you would like to have Keter automatically create a PostgreSQL database
# and set appropriate environment variables for it to be discovered, uncomment
# the following line.
# plugins:
# postgres: true

View File

@ -0,0 +1,8 @@
-- By default this file is used by `parseRoutesFile` in Foundation.hs
-- Syntax for this file here: https://www.yesodweb.com/book/routing-and-handlers
-- /static StaticR Static appStatic
{{#routes}}
{{path}} {{resource}}{{#methods}} {{this}}{{/methods}}
{{/routes}}

View File

@ -0,0 +1,25 @@
# Values formatted like "_env:YESOD_ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
# See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
static-dir: "_env:YESOD_STATIC_DIR:static"
host: "_env:YESOD_HOST:*4" # any IPv4 host
port: "_env:YESOD_PORT:3000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
ip-from-header: "_env:YESOD_IP_FROM_HEADER:false"
# Default behavior: determine the application root from the request headers.
# Uncomment to set an explicit approot
#approot: "_env:YESOD_APPROOT:http://localhost:3000"
# By default, `yesod devel` runs in development, and built executables use
# production settings (see below). To override this, use the following:
#
# development: false
# Optional values with the following production defaults.
# In development, they default to the inverse.
#
# detailed-logging: false
# should-log-all: false
# reload-templates: false
# mutable-static: false
# skip-combining: false

View File

@ -0,0 +1,4 @@
((haskell-mode . ((haskell-indent-spaces . 4)
(haskell-process-use-ghci . t)))
(hamlet-mode . ((hamlet/basic-offset . 4)
(haskell-process-use-ghci . t))))

View File

@ -0,0 +1,22 @@
dist*
static/tmp/
static/combined/
config/client_session_key.aes
*.hi
*.o
*.sqlite3
*.sqlite3-shm
*.sqlite3-wal
.hsenv*
cabal-dev/
.stack-work/
.stack-work-devel/
yesod-devel/
.cabal-sandbox
cabal.sandbox.config
.DS_Store
*.swp
*.keter
*~
\#*
{{projectName}}.cabal

View File

@ -0,0 +1,80 @@
name: {{projectName}}
version: "0.0.0"
dependencies:
- base >=4.9.1.0 && <5
- yesod >=1.6 && <1.7
- yesod-core >=1.6 && <1.7
- yesod-static >=1.6 && <1.7
- classy-prelude >=1.5 && <1.6
- classy-prelude-yesod >=1.5 && <1.6
- template-haskell
- wai-extra >=3.0 && <3.1
- yaml >=0.11 && <0.12
- http-client-tls >=0.3 && <0.4
- warp >=3.0 && <3.4
- aeson >=1.4 && <1.5
- monad-logger >=0.3 && <0.4
- fast-logger >=2.2 && <3.1
- wai-logger >=2.2 && <2.4
- file-embed
- wai
- foreign-store
- text
- containers
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.
library:
source-dirs: src
when:
- condition: (flag(dev)) || (flag(library-only))
then:
ghc-options:
- -Wall
- -fwarn-tabs
- -O0
cpp-options: -DDEVELOPMENT
else:
ghc-options:
- -Wall
- -fwarn-tabs
- -O2
# Runnable executable for our application
executables:
{{projectName}}:
main: main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- {{projectName}}
when:
- condition: flag(library-only)
buildable: false
# Test suite
tests:
{{projectName}}-test:
main: Spec.hs
source-dirs: test
ghc-options: -Wall
dependencies:
- {{projectName}}
- hspec >=2.0.0
- yesod-test
# Define flags used by "yesod devel" to make compilation faster
flags:
library-only:
description: Build for use with "yesod devel"
manual: false
default: false
dev:
description: Turn on development settings, like auto-reload templates.
manual: false
default: false

View File

@ -0,0 +1,81 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
module {{apiModuleName}}.Types (
{{#models}}
{{#model}}
{{classname}} (..),
{{/model}}
{{/models}}
) where
import ClassyPrelude.Yesod
import Data.Foldable (foldl)
import Data.Maybe (fromMaybe)
import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
import Data.Aeson.Types (Options(..), defaultOptions)
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Function ((&))
{{#imports}}import {{import}}
{{/imports}}
{{#models}}
{{#model}}
-- | {{description}}
{{^vendorExtensions.x-custom-newtype}}
{{^parent}}
{{vendorExtensions.x-data}} {{classname}} = {{classname}}
{ {{#vars}}{{& name}} :: {{^required}}Maybe {{/required}}{{dataType}} -- ^ {{& description}}{{^-last}}
, {{/-last}}{{/vars}}
} deriving (Show, Eq, Generic)
instance FromJSON {{classname}} where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}")
instance ToJSON {{classname}} where
toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}")
{{/parent}}
{{#parent}}
newtype {{classname}} = {{classname}} { un{{classname}} :: {{parent}} }
deriving (Show, Eq, FromJSON, ToJSON, Generic)
{{/parent}}
{{/vendorExtensions.x-custom-newtype}}
{{#vendorExtensions.x-custom-newtype}}
newtype {{classname}} = {{classname}} {{vendorExtensions.x-custom-newtype}} deriving (Show, Eq, FromJSON, ToJSON, Generic)
{{/vendorExtensions.x-custom-newtype}}
{{/model}}
{{/models}}
uncapitalize :: String -> String
uncapitalize (c : cs) = Char.toLower c : cs
uncapitalize [] = []
-- | Remove a field label prefix during JSON parsing.
-- Also perform any replacements for special characters.
-- The @forParsing@ parameter is to distinguish between the cases in which we're using this
-- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want
-- to replace special characters with their quoted equivalents (because we cannot have special
-- chars in identifier names), while we want to do viceversa when sending data instead.
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix =
defaultOptions
{ omitNothingFields = True
, fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
}
where
replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
specialChars =
[ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{^-last}}
, {{/-last}}{{/specialCharReplacements}}
]
mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
replacer =
if forParsing
then flip T.replace
else T.replace

View File

@ -0,0 +1,164 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( getApplicationDev
, appMain
, develMain
, makeFoundation
, makeLogWare
-- * for DevelMain
, getApplicationRepl
, shutdownApp
-- * for GHCI
, handler
) where
import Control.Monad.Logger (liftLoc)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import Network.HTTP.Client.TLS (getGlobalManager)
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException,
runSettings, setHost,
setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..),
OutputFormat (..), destination,
mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
{{#apiInfo}}
{{#apis}}
import Handler.{{classname}}
{{/apis}}
{{/apiInfo}}
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
-- comments there for more details.
mkYesodDispatch "App" resourcesApp
-- | This function allocates resources (such as a database connection pool),
-- performs initialization and returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
-- Some basic initializations: HTTP connection manager, logger, and static
-- subsite.
appHttpManager <- getGlobalManager
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
appStatic <-
(if appMutableStatic appSettings then staticDevel else static)
(appStaticDir appSettings)
-- Return the foundation
return App {..}
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares.
makeApplication :: App -> IO Application
makeApplication foundation = do
logWare <- makeLogWare foundation
-- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation
return $ logWare $ defaultMiddlewaresNoLogging appPlain
makeLogWare :: App -> IO Middleware
makeLogWare foundation =
mkRequestLogger def
{ outputFormat =
if appDetailedRequestLogging $ appSettings foundation
then Detailed True
else Apache
(if appIpFromHeader $ appSettings foundation
then FromFallback
else FromSocket)
, destination = Logger $ loggerSet $ appLogger foundation
}
-- | Warp settings for the given foundation value.
warpSettings :: App -> Settings
warpSettings foundation =
setPort (appPort $ appSettings foundation)
$ setHost (appHost $ appSettings foundation)
$ setOnException (\_req e ->
when (defaultShouldDisplayException e) $ messageLoggerSource
foundation
(appLogger foundation)
$(qLocation >>= liftLoc)
"yesod"
LevelError
(toLogStr $ "Exception from Warp: " ++ show e))
defaultSettings
-- | For yesod devel, return the Warp settings and WAI Application.
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app <- makeApplication foundation
return (wsettings, app)
getAppSettings :: IO AppSettings
getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
-- | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev
-- | The @main@ function for an executable running this site.
appMain :: IO ()
appMain = do
-- Get the settings from all relevant sources
settings <- loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime
[configSettingsYmlValue]
-- allow environment variables to override
useEnv
-- Generate the foundation from the settings
foundation <- makeFoundation settings
-- Generate a WAI Application from the foundation
app <- makeApplication foundation
-- Run the application with Warp
runSettings (warpSettings foundation) app
--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
--------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app1 <- makeApplication foundation
return (getPort wsettings, foundation, app1)
shutdownApp :: App -> IO ()
shutdownApp _ = return ()
---------------------------------------------
-- Functions for use in development with GHCi
---------------------------------------------
-- | Run a handler
handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h

View File

@ -0,0 +1,50 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Error where
import ClassyPrelude.Yesod
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE
data ErrorResponseBody = ErrorResponseBody
{ title :: T.Text
, detail :: T.Text
}
instance ToContent ErrorResponseBody where
toContent = toContent . encode
instance ToTypedContent ErrorResponseBody where
toTypedContent = TypedContent "application/json" . toContent
$(deriveJSON defaultOptions 'ErrorResponseBody)
defaultErrorHandlerJson :: Yesod site => ErrorResponse -> HandlerFor site TypedContent
-- 400
defaultErrorHandlerJson (InvalidArgs ia) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Bad Request" $ T.intercalate " " ia
-- 401
defaultErrorHandlerJson NotAuthenticated = fmap toTypedContent $ returnJson $
ErrorResponseBody "Unauthorized" "authentication required"
-- 403
defaultErrorHandlerJson (PermissionDenied _) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Forbidden" "unauthorized"
-- 404
defaultErrorHandlerJson NotFound = fmap toTypedContent $ returnJson $
ErrorResponseBody "Not Found" "resource not found"
-- 405
defaultErrorHandlerJson (BadMethod m) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Method Not Allowed" $ "method " <> TE.decodeUtf8With TEE.lenientDecode m <> " not supported"
-- 500
defaultErrorHandlerJson (InternalError e) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Internal Server Error" e
-- 501
notImplemented :: HandlerFor site res
notImplemented = sendResponseStatus notImplemented501 $
ErrorResponseBody "Not Implemented" "operation not implemented"

View File

@ -0,0 +1,97 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE InstanceSigs #-}
module Foundation where
import Import.NoFoundation
import Control.Monad.Logger (LogSource)
import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe
-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = App
{ appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving.
, appHttpManager :: Manager
, appLogger :: Logger
}
-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers
--
-- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation
-- for an explanation for this split:
-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
--
-- This function also generates the following type synonyms:
-- type Handler = HandlerFor App
-- type Widget = WidgetFor App ()
mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod App where
-- Controls the base of generated URLs. For more information on modifying,
-- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
approot :: Approot App
approot = ApprootRequest $ \app req ->
case appRoot $ appSettings app of
Nothing -> getApprootText guessApproot app req
Just root -> root
makeSessionBackend :: App -> IO (Maybe SessionBackend)
makeSessionBackend _ = return Nothing
-- Yesod Middleware allows you to run code before and after each handler function.
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
-- Some users may also want to add the defaultCsrfMiddleware, which:
-- a) Sets a cookie with a CSRF token in it.
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
yesodMiddleware = defaultYesodMiddleware
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
shouldLogIO app _source level =
return $
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
makeLogger :: App -> IO Logger
makeLogger = return . appLogger
errorHandler :: ErrorResponse -> Handler TypedContent
errorHandler = defaultErrorHandlerJson
-- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where
getHttpManager :: App -> Manager
getHttpManager = appHttpManager
unsafeHandler :: App -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-- Note: Some functionality previously present in the scaffolding has been
-- moved to documentation in the Wiki. Following are some hopefully helpful
-- links:
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding

View File

@ -0,0 +1,6 @@
module Import
( module Import
) where
import Foundation as Import
import Import.NoFoundation as Import

View File

@ -0,0 +1,11 @@
{-# LANGUAGE CPP #-}
module Import.NoFoundation
( module Import
) where
import ClassyPrelude.Yesod as Import
import Error as Import
import Settings as Import
-- import Settings.StaticFiles as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import

View File

@ -0,0 +1,86 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module Settings where
import ClassyPrelude.Yesod
import qualified Control.Exception as Exception
import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
(.:?))
import Data.FileEmbed (embedFile)
import Data.Yaml (decodeEither')
import Network.Wai.Handler.Warp (HostPreference)
import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
data AppSettings = AppSettings
{ appStaticDir :: String
-- ^ Directory from which to serve static files.
, appRoot :: Maybe Text
-- ^ Base for all generated URLs. If @Nothing@, determined
-- from the request headers.
, appHost :: HostPreference
-- ^ Host/interface the server should bind to.
, appPort :: Int
-- ^ Port to listen on
, appIpFromHeader :: Bool
-- ^ Get the IP address from the header when logging. Useful when sitting
-- behind a reverse proxy.
, appDetailedRequestLogging :: Bool
-- ^ Use detailed request logging system
, appShouldLogAll :: Bool
-- ^ Should all log messages be displayed?
, appMutableStatic :: Bool
-- ^ Assume that files in the static dir may change after compilation
}
instance FromJSON AppSettings where
parseJSON = withObject "AppSettings" $ \o -> do
let defaultDev =
#ifdef DEVELOPMENT
True
#else
False
#endif
appStaticDir <- o .: "static-dir"
appRoot <- o .:? "approot"
appHost <- fromString <$> o .: "host"
appPort <- o .: "port"
appIpFromHeader <- o .: "ip-from-header"
dev <- o .:? "development" .!= defaultDev
appDetailedRequestLogging <- o .:? "detailed-logging" .!= dev
appShouldLogAll <- o .:? "should-log-all" .!= dev
appMutableStatic <- o .:? "mutable-static" .!= dev
return AppSettings {..}
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- | Raw bytes at compile time of @config/settings.yml@
configSettingsYmlBS :: ByteString
configSettingsYmlBS = $(embedFile configSettingsYml)
-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue :: Value
configSettingsYmlValue = either Exception.throw id
$ decodeEither' configSettingsYmlBS
-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings :: AppSettings
compileTimeAppSettings =
case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
Error e -> error e
Success settings -> settings

View File

@ -0,0 +1,21 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Settings.StaticFiles where
import Settings (appStaticDir, compileTimeAppSettings)
import Yesod.Static (staticFiles)
-- This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
--
-- For example, to refer to @static/js/script.js@ via an identifier, you'd use:
--
-- js_script_js
--
-- If the identifier is not available, you may use:
--
-- StaticFile ["js", "script.js"] []
staticFiles (appStaticDir compileTimeAppSettings)

View File

@ -0,0 +1,67 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

View File

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

View File

@ -0,0 +1,31 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module TestImport
( module TestImport
, module X
) where
import Application (makeFoundation, makeLogWare)
import ClassyPrelude as X hiding (Handler)
import Foundation as X
import Test.Hspec as X
import Yesod.Default.Config2 (useEnv, loadYamlSettings)
import Yesod.Test as X
import Yesod.Core.Unsafe (fakeHandlerGetLogger)
runHandler :: Handler a -> YesodExample App a
runHandler handler = do
app <- getTestYesod
fakeHandlerGetLogger appLogger app handler
withApp :: SpecWith (TestApp App) -> Spec
withApp = before $ do
settings <- loadYamlSettings
["config/test-settings.yml", "config/settings.yml"]
[]
useEnv
foundation <- makeFoundation settings
logWare <- liftIO $ makeLogWare foundation
return (foundation, logWare)

View File

@ -0,0 +1,62 @@
package org.openapitools.codegen.haskellyesod;
import java.util.*;
import org.openapitools.codegen.TestUtils;
import org.openapitools.codegen.languages.HaskellYesodServerCodegen;
import org.testng.Assert;
import org.testng.annotations.Test;
public class HaskellYesodServerCodegenTest {
@Test
public void testToApiTestFilename() throws Exception {
final HaskellYesodServerCodegen codegen = new HaskellYesodServerCodegen();
codegen.processOpts();
Assert.assertEquals(codegen.toApiTestFilename("Foo"), "FooSpec");
Assert.assertEquals(codegen.toApiTestFilename("foo"), "FooSpec");
Assert.assertEquals(codegen.toApiTestFilename("FOO"), "FOOSpec");
Assert.assertEquals(codegen.toApiTestFilename("foo-bar"), "FooBarSpec");
Assert.assertEquals(codegen.toApiTestFilename("foo_bar"), "FooBarSpec");
}
@Test
public void testIsOverlappedPath() throws Exception {
final HaskellYesodServerCodegen codegen = new HaskellYesodServerCodegen();
codegen.processOpts();
Assert.assertTrue(codegen.isOverlappedPath("/foo", "/#param"));
Assert.assertTrue(codegen.isOverlappedPath("/#param", "/foo"));
Assert.assertTrue(codegen.isOverlappedPath("/foo/bar", "/foo/#param"));
Assert.assertTrue(codegen.isOverlappedPath("/foo/bar", "/#param/bar"));
Assert.assertTrue(codegen.isOverlappedPath("/foo/bar", "/#param1/#param2"));
Assert.assertFalse(codegen.isOverlappedPath("/foo", "/bar"));
Assert.assertFalse(codegen.isOverlappedPath("/foo", "/foo"));
Assert.assertFalse(codegen.isOverlappedPath("/foo", "/foo/#param"));
}
@Test
public void testHasOverlappedPath() throws Exception {
final HaskellYesodServerCodegen codegen = new HaskellYesodServerCodegen();
codegen.processOpts();
Assert.assertTrue(codegen.hasOverlappedPath("/foo", toRoutes("/#param")));
Assert.assertTrue(codegen.hasOverlappedPath("/foo", toRoutes("/foo", "/#param")));
Assert.assertTrue(codegen.hasOverlappedPath("/foo", toRoutes("/#param", "/foo")));
Assert.assertFalse(codegen.hasOverlappedPath("/foo", toRoutes()));
Assert.assertFalse(codegen.hasOverlappedPath("/foo", toRoutes("/bar")));
Assert.assertFalse(codegen.hasOverlappedPath("/foo", toRoutes("!/#param")));
}
private List<Map<String, Object>> toRoutes(String... paths) {
List<Map<String, Object>> routes = new ArrayList<Map<String, Object>>();
for (String path : paths) {
Map<String, Object> route = new HashMap<String, Object>();
route.put("path", path);
routes.add(route);
}
return routes;
}
}

View File

@ -0,0 +1,29 @@
package org.openapitools.codegen.haskellyesod;
import org.openapitools.codegen.AbstractOptionsTest;
import org.openapitools.codegen.CodegenConfig;
import org.openapitools.codegen.languages.HaskellYesodServerCodegen;
import org.openapitools.codegen.options.HaskellYesodServerOptionsProvider;
import static org.mockito.Mockito.mock;
import static org.mockito.Mockito.verify;
public class HaskellYesodServerOptionsTest extends AbstractOptionsTest {
private HaskellYesodServerCodegen clientCodegen = mock(HaskellYesodServerCodegen.class, mockSettings);
public HaskellYesodServerOptionsTest() {
super(new HaskellYesodServerOptionsProvider());
}
@Override
protected CodegenConfig getCodegenConfig() {
return clientCodegen;
}
@Override
protected void verifyOptions() {
verify(clientCodegen).setProjectName(HaskellYesodServerOptionsProvider.PROJECT_NAME_VALUE);
verify(clientCodegen).setApiModuleName(HaskellYesodServerOptionsProvider.API_MODULE_NAME_VALUE);
}
}

View File

@ -0,0 +1,42 @@
package org.openapitools.codegen.options;
import com.google.common.collect.ImmutableMap;
import org.openapitools.codegen.CodegenConstants;
import org.openapitools.codegen.languages.HaskellYesodServerCodegen;
import java.util.Map;
public class HaskellYesodServerOptionsProvider implements OptionsProvider {
public static final String SORT_PARAMS_VALUE = "false";
public static final String SORT_MODEL_PROPERTIES_VALUE = "false";
public static final String ENSURE_UNIQUE_PARAMS_VALUE = "true";
public static final String ALLOW_UNICODE_IDENTIFIERS_VALUE = "false";
public static final String PREPEND_FORM_OR_BODY_PARAMETERS_VALUE = "true";
public static final String PROJECT_NAME_VALUE = "openapi-haskell-yesod-server";
public static final String API_MODULE_NAME_VALUE = "API";
@Override
public String getLanguage() {
return "haskell-yesod";
}
@Override
public Map<String, String> createOptions() {
ImmutableMap.Builder<String, String> builder = new ImmutableMap.Builder<String, String>();
return builder.put(CodegenConstants.SORT_PARAMS_BY_REQUIRED_FLAG, SORT_PARAMS_VALUE)
.put(CodegenConstants.SORT_MODEL_PROPERTIES_BY_REQUIRED_FLAG, SORT_MODEL_PROPERTIES_VALUE)
.put(CodegenConstants.ENSURE_UNIQUE_PARAMS, ENSURE_UNIQUE_PARAMS_VALUE)
.put(CodegenConstants.ALLOW_UNICODE_IDENTIFIERS, ALLOW_UNICODE_IDENTIFIERS_VALUE)
.put(CodegenConstants.PREPEND_FORM_OR_BODY_PARAMETERS, PREPEND_FORM_OR_BODY_PARAMETERS_VALUE)
.put(CodegenConstants.LEGACY_DISCRIMINATOR_BEHAVIOR, "true")
.put(CodegenConstants.DISALLOW_ADDITIONAL_PROPERTIES_IF_NOT_PRESENT, "true")
.put(HaskellYesodServerCodegen.PROJECT_NAME, PROJECT_NAME_VALUE)
.put(HaskellYesodServerCodegen.API_MODULE_NAME, API_MODULE_NAME_VALUE)
.build();
}
@Override
public boolean isServer() {
return true;
}
}

View File

@ -0,0 +1,4 @@
((haskell-mode . ((haskell-indent-spaces . 4)
(haskell-process-use-ghci . t)))
(hamlet-mode . ((hamlet/basic-offset . 4)
(haskell-process-use-ghci . t))))

View File

@ -0,0 +1,22 @@
dist*
static/tmp/
static/combined/
config/client_session_key.aes
*.hi
*.o
*.sqlite3
*.sqlite3-shm
*.sqlite3-wal
.hsenv*
cabal-dev/
.stack-work/
.stack-work-devel/
yesod-devel/
.cabal-sandbox
cabal.sandbox.config
.DS_Store
*.swp
*.keter
*~
\#*
open-api-petstore.cabal

View File

@ -0,0 +1,23 @@
# OpenAPI Generator Ignore
# Generated by openapi-generator https://github.com/openapitools/openapi-generator
# Use this file to prevent files from being overwritten by the generator.
# The patterns follow closely to .gitignore or .dockerignore.
# As an example, the C# client generator defines ApiClient.cs.
# You can make changes and tell OpenAPI Generator to ignore just this file by uncommenting the following line:
#ApiClient.cs
# You can match any string of characters against a directory, file or extension with a single asterisk (*):
#foo/*/qux
# The above matches foo/bar/qux and foo/baz/qux, but not foo/bar/baz/qux
# You can recursively match patterns against a directory, file or extension with a double asterisk (**):
#foo/**/qux
# This matches foo/bar/qux, foo/baz/qux, and foo/bar/baz/qux
# You can also negate patterns with an exclamation (!).
# For example, you can ignore all files in a docs folder with the file extension .md:
#docs/*.md
# Then explicitly reverse the ignore rule for a single file:
#!docs/README.md

View File

@ -0,0 +1,30 @@
.dir-locals.el
.gitignore
.openapi-generator-ignore
README.md
app/DevelMain.hs
app/devel.hs
app/main.hs
config/keter.yml
config/routes.yesodroutes
config/settings.yml
config/test-settings.yml
package.yaml
src/Application.hs
src/Error.hs
src/Foundation.hs
src/Handler/Pet.hs
src/Handler/Store.hs
src/Handler/User.hs
src/Import.hs
src/Import/NoFoundation.hs
src/OpenAPIPetstore/Types.hs
src/Settings.hs
src/Settings/StaticFiles.hs
stack.yaml
static/.gitkeep
test/Handler/PetSpec.hs
test/Handler/StoreSpec.hs
test/Handler/UserSpec.hs
test/Spec.hs
test/TestImport.hs

View File

@ -0,0 +1 @@
5.3.0-SNAPSHOT

View File

@ -0,0 +1,43 @@
## Haskell Setup
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
2. Install the `yesod` command line tool: `stack install yesod-bin --install-ghc`
3. Build libraries: `stack build`
If you have trouble, refer to the [Yesod Quickstart guide](https://www.yesodweb.com/page/quickstart) for additional detail.
## Development
Start a development server with:
```
stack exec -- yesod devel
```
As your code changes, your site will be automatically recompiled and redeployed to localhost.
## Tests
```
stack test --flag open-api-petstore:library-only --flag open-api-petstore:dev
```
(Because `yesod devel` passes the `library-only` and `dev` flags, matching those flags means you don't need to recompile between tests and development, and it disables optimization to speed up your test compile times).
## Documentation
* Read the [Yesod Book](https://www.yesodweb.com/book) online for free
* Check [Stackage](http://stackage.org/) for documentation on the packages in your LTS Haskell version, or [search it using Hoogle](https://www.stackage.org/lts/hoogle?q=). Tip: Your LTS version is in your `stack.yaml` file.
* For local documentation, use:
* `stack haddock --open` to generate Haddock documentation for your dependencies, and open that documentation in a browser
* `stack hoogle <function, module or type signature>` to generate a Hoogle database and search for your query
* The [Yesod cookbook](https://github.com/yesodweb/yesod-cookbook) has sample code for various needs
## Getting Help
* Ask questions on [Stack Overflow, using the Yesod or Haskell tags](https://stackoverflow.com/questions/tagged/yesod+haskell)
* Ask the [Yesod Google Group](https://groups.google.com/forum/#!forum/yesodweb)
* There are several chatrooms you can ask for help:
* For IRC, try Freenode#yesod and Freenode#haskell
* [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels.

View File

@ -0,0 +1,105 @@
-- | Running your app inside GHCi.
--
-- This option provides significantly faster code reload compared to
-- @yesod devel@. However, you do not get automatic code reload
-- (which may be a benefit, depending on your perspective). To use this:
--
-- 1. Start up GHCi
--
-- $ stack ghci open-api-petstore:lib --no-load --work-dir .stack-work-devel
--
-- 2. Load this module
--
-- > :l app/DevelMain.hs
--
-- 3. Run @update@
--
-- > DevelMain.update
--
-- 4. Your app should now be running, you can connect at http://localhost:3000
--
-- 5. Make changes to your code
--
-- 6. After saving your changes, reload by running:
--
-- > :r
-- > DevelMain.update
--
-- You can also call @DevelMain.shutdown@ to stop the app
--
-- There is more information about this approach,
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
--
-- WARNING: GHCi does not notice changes made to your template files.
-- If you change a template, you'll need to either exit GHCi and reload,
-- or manually @touch@ another Haskell module.
module DevelMain where
import Prelude
import Application (getApplicationRepl, shutdownApp)
import Control.Monad ((>=>))
import Control.Concurrent
import Data.IORef
import Foreign.Store
import Network.Wai.Handler.Warp
import GHC.Word
-- | Start or restart the server.
-- newStore is from foreign-store.
-- A Store holds onto some data across ghci reloads
update :: IO ()
update = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
Just tidStore -> restartAppInNewThread tidStore
where
doneStore :: Store (MVar ())
doneStore = Store 0
-- shut the server down with killThread and wait for the done signal
restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
-- | Start the server in a separate thread.
start :: MVar () -- ^ Written to when the thread is killed.
-> IO ThreadId
start done = do
(port, site, app) <- getApplicationRepl
forkFinally
(runSettings (setPort port defaultSettings) app)
-- Note that this implies concurrency
-- between shutdownApp and the next app that is starting.
-- Normally this should be fine
(\_ -> putMVar done () >> shutdownApp site)
-- | kill the server
shutdown :: IO ()
shutdown = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> putStrLn "no Yesod app running"
Just tidStore -> do
withStore tidStore $ readIORef >=> killThread
putStrLn "Yesod app is shutdown"
tidStoreNum :: Word32
tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref

View File

@ -0,0 +1,6 @@
{-# LANGUAGE PackageImports #-}
import "open-api-petstore" Application (develMain)
import Prelude (IO)
main :: IO ()
main = develMain

View File

@ -0,0 +1,5 @@
import Prelude (IO)
import Application (appMain)
main :: IO ()
main = appMain

View File

@ -0,0 +1,70 @@
# After you've edited this file, remove the following line to allow
# `yesod keter` to build your bundle.
user-edited: false
# A Keter app is composed of 1 or more stanzas. The main stanza will define our
# web application. See the Keter documentation for more information on
# available stanzas.
stanzas:
# Your Yesod application.
- type: webapp
# Name of your executable. You are unlikely to need to change this.
# Note that all file paths are relative to the keter.yml file.
#
# The path given is for Stack projects. If you're still using cabal, change
# to
# exec: ../dist/build/open-api-petstore/open-api-petstore
exec: ../dist/bin/open-api-petstore
# Command line options passed to your application.
args: []
hosts:
# You can specify one or more hostnames for your application to respond
# to. The primary hostname will be used for generating your application
# root.
- www.open-api-petstore.com
# Enable to force Keter to redirect to https
# Can be added to any stanza
requires-secure: false
# Static files.
- type: static-files
hosts:
- static.open-api-petstore.com
root: ../static
# Uncomment to turn on directory listings.
# directory-listing: true
# Redirect plain domain name to www.
- type: redirect
hosts:
- open-api-petstore.com
actions:
- host: www.open-api-petstore.com
# secure: false
# port: 80
# Uncomment to switch to a non-permanent redirect.
# status: 303
# Use the following to automatically copy your bundle upon creation via `yesod
# keter`. Uses `scp` internally, so you can set it to a remote destination
# copy-to: user@host:/opt/keter/incoming/
# You can pass arguments to `scp` used above. This example limits bandwidth to
# 1024 Kbit/s and uses port 2222 instead of the default 22
# copy-to-args:
# - "-l 1024"
# - "-P 2222"
# If you would like to have Keter automatically create a PostgreSQL database
# and set appropriate environment variables for it to be discovered, uncomment
# the following line.
# plugins:
# postgres: true

View File

@ -0,0 +1,20 @@
-- By default this file is used by `parseRoutesFile` in Foundation.hs
-- Syntax for this file here: https://www.yesodweb.com/book/routing-and-handlers
-- /static StaticR Static appStatic
/pet PetR PUT POST
/pet/findByStatus PetFindByStatusR GET
/pet/findByTags PetFindByTagsR GET
!/pet/#Int64 PetByInt64R GET POST DELETE
/pet/#Int64/uploadImage PetByInt64UploadImageR POST
/store/inventory StoreInventoryR GET
/store/order StoreOrderR POST
/store/order/#Int64 StoreOrderByInt64R GET
!/store/order/#Text StoreOrderByTextR DELETE
/user UserR POST
/user/createWithArray UserCreateWithArrayR POST
/user/createWithList UserCreateWithListR POST
/user/login UserLoginR GET
/user/logout UserLogoutR GET
!/user/#Text UserByTextR GET PUT DELETE

View File

@ -0,0 +1,25 @@
# Values formatted like "_env:YESOD_ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
# See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
static-dir: "_env:YESOD_STATIC_DIR:static"
host: "_env:YESOD_HOST:*4" # any IPv4 host
port: "_env:YESOD_PORT:3000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
ip-from-header: "_env:YESOD_IP_FROM_HEADER:false"
# Default behavior: determine the application root from the request headers.
# Uncomment to set an explicit approot
#approot: "_env:YESOD_APPROOT:http://localhost:3000"
# By default, `yesod devel` runs in development, and built executables use
# production settings (see below). To override this, use the following:
#
# development: false
# Optional values with the following production defaults.
# In development, they default to the inverse.
#
# detailed-logging: false
# should-log-all: false
# reload-templates: false
# mutable-static: false
# skip-combining: false

View File

@ -0,0 +1 @@
{}

View File

@ -0,0 +1,80 @@
name: open-api-petstore
version: "0.0.0"
dependencies:
- base >=4.9.1.0 && <5
- yesod >=1.6 && <1.7
- yesod-core >=1.6 && <1.7
- yesod-static >=1.6 && <1.7
- classy-prelude >=1.5 && <1.6
- classy-prelude-yesod >=1.5 && <1.6
- template-haskell
- wai-extra >=3.0 && <3.1
- yaml >=0.11 && <0.12
- http-client-tls >=0.3 && <0.4
- warp >=3.0 && <3.4
- aeson >=1.4 && <1.5
- monad-logger >=0.3 && <0.4
- fast-logger >=2.2 && <3.1
- wai-logger >=2.2 && <2.4
- file-embed
- wai
- foreign-store
- text
- containers
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.
library:
source-dirs: src
when:
- condition: (flag(dev)) || (flag(library-only))
then:
ghc-options:
- -Wall
- -fwarn-tabs
- -O0
cpp-options: -DDEVELOPMENT
else:
ghc-options:
- -Wall
- -fwarn-tabs
- -O2
# Runnable executable for our application
executables:
open-api-petstore:
main: main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- open-api-petstore
when:
- condition: flag(library-only)
buildable: false
# Test suite
tests:
open-api-petstore-test:
main: Spec.hs
source-dirs: test
ghc-options: -Wall
dependencies:
- open-api-petstore
- hspec >=2.0.0
- yesod-test
# Define flags used by "yesod devel" to make compilation faster
flags:
library-only:
description: Build for use with "yesod devel"
manual: false
default: false
dev:
description: Turn on development settings, like auto-reload templates.
manual: false
default: false

View File

@ -0,0 +1,162 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( getApplicationDev
, appMain
, develMain
, makeFoundation
, makeLogWare
-- * for DevelMain
, getApplicationRepl
, shutdownApp
-- * for GHCI
, handler
) where
import Control.Monad.Logger (liftLoc)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import Network.HTTP.Client.TLS (getGlobalManager)
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException,
runSettings, setHost,
setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..),
OutputFormat (..), destination,
mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Pet
import Handler.Store
import Handler.User
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
-- comments there for more details.
mkYesodDispatch "App" resourcesApp
-- | This function allocates resources (such as a database connection pool),
-- performs initialization and returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
-- Some basic initializations: HTTP connection manager, logger, and static
-- subsite.
appHttpManager <- getGlobalManager
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
appStatic <-
(if appMutableStatic appSettings then staticDevel else static)
(appStaticDir appSettings)
-- Return the foundation
return App {..}
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares.
makeApplication :: App -> IO Application
makeApplication foundation = do
logWare <- makeLogWare foundation
-- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation
return $ logWare $ defaultMiddlewaresNoLogging appPlain
makeLogWare :: App -> IO Middleware
makeLogWare foundation =
mkRequestLogger def
{ outputFormat =
if appDetailedRequestLogging $ appSettings foundation
then Detailed True
else Apache
(if appIpFromHeader $ appSettings foundation
then FromFallback
else FromSocket)
, destination = Logger $ loggerSet $ appLogger foundation
}
-- | Warp settings for the given foundation value.
warpSettings :: App -> Settings
warpSettings foundation =
setPort (appPort $ appSettings foundation)
$ setHost (appHost $ appSettings foundation)
$ setOnException (\_req e ->
when (defaultShouldDisplayException e) $ messageLoggerSource
foundation
(appLogger foundation)
$(qLocation >>= liftLoc)
"yesod"
LevelError
(toLogStr $ "Exception from Warp: " ++ show e))
defaultSettings
-- | For yesod devel, return the Warp settings and WAI Application.
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app <- makeApplication foundation
return (wsettings, app)
getAppSettings :: IO AppSettings
getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
-- | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev
-- | The @main@ function for an executable running this site.
appMain :: IO ()
appMain = do
-- Get the settings from all relevant sources
settings <- loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime
[configSettingsYmlValue]
-- allow environment variables to override
useEnv
-- Generate the foundation from the settings
foundation <- makeFoundation settings
-- Generate a WAI Application from the foundation
app <- makeApplication foundation
-- Run the application with Warp
runSettings (warpSettings foundation) app
--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
--------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
settings <- getAppSettings
foundation <- makeFoundation settings
wsettings <- getDevSettings $ warpSettings foundation
app1 <- makeApplication foundation
return (getPort wsettings, foundation, app1)
shutdownApp :: App -> IO ()
shutdownApp _ = return ()
---------------------------------------------
-- Functions for use in development with GHCi
---------------------------------------------
-- | Run a handler
handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h

View File

@ -0,0 +1,50 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Error where
import ClassyPrelude.Yesod
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE
data ErrorResponseBody = ErrorResponseBody
{ title :: T.Text
, detail :: T.Text
}
instance ToContent ErrorResponseBody where
toContent = toContent . encode
instance ToTypedContent ErrorResponseBody where
toTypedContent = TypedContent "application/json" . toContent
$(deriveJSON defaultOptions 'ErrorResponseBody)
defaultErrorHandlerJson :: Yesod site => ErrorResponse -> HandlerFor site TypedContent
-- 400
defaultErrorHandlerJson (InvalidArgs ia) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Bad Request" $ T.intercalate " " ia
-- 401
defaultErrorHandlerJson NotAuthenticated = fmap toTypedContent $ returnJson $
ErrorResponseBody "Unauthorized" "authentication required"
-- 403
defaultErrorHandlerJson (PermissionDenied _) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Forbidden" "unauthorized"
-- 404
defaultErrorHandlerJson NotFound = fmap toTypedContent $ returnJson $
ErrorResponseBody "Not Found" "resource not found"
-- 405
defaultErrorHandlerJson (BadMethod m) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Method Not Allowed" $ "method " <> TE.decodeUtf8With TEE.lenientDecode m <> " not supported"
-- 500
defaultErrorHandlerJson (InternalError e) = fmap toTypedContent $ returnJson $
ErrorResponseBody "Internal Server Error" e
-- 501
notImplemented :: HandlerFor site res
notImplemented = sendResponseStatus notImplemented501 $
ErrorResponseBody "Not Implemented" "operation not implemented"

View File

@ -0,0 +1,97 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE InstanceSigs #-}
module Foundation where
import Import.NoFoundation
import Control.Monad.Logger (LogSource)
import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe
-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = App
{ appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving.
, appHttpManager :: Manager
, appLogger :: Logger
}
-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers
--
-- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation
-- for an explanation for this split:
-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
--
-- This function also generates the following type synonyms:
-- type Handler = HandlerFor App
-- type Widget = WidgetFor App ()
mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod App where
-- Controls the base of generated URLs. For more information on modifying,
-- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
approot :: Approot App
approot = ApprootRequest $ \app req ->
case appRoot $ appSettings app of
Nothing -> getApprootText guessApproot app req
Just root -> root
makeSessionBackend :: App -> IO (Maybe SessionBackend)
makeSessionBackend _ = return Nothing
-- Yesod Middleware allows you to run code before and after each handler function.
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
-- Some users may also want to add the defaultCsrfMiddleware, which:
-- a) Sets a cookie with a CSRF token in it.
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
yesodMiddleware = defaultYesodMiddleware
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
shouldLogIO app _source level =
return $
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
makeLogger :: App -> IO Logger
makeLogger = return . appLogger
errorHandler :: ErrorResponse -> Handler TypedContent
errorHandler = defaultErrorHandlerJson
-- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where
getHttpManager :: App -> Manager
getHttpManager = appHttpManager
unsafeHandler :: App -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-- Note: Some functionality previously present in the scaffolding has been
-- moved to documentation in the Wiki. Following are some hopefully helpful
-- links:
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding

View File

@ -0,0 +1,61 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Handler.Pet where
import Import
-- | Add a new pet to the store
--
-- operationId: addPet
postPetR :: Handler Value
postPetR = notImplemented
-- | Deletes a pet
--
-- operationId: deletePet
deletePetByInt64R :: Int64 -- ^ Pet id to delete
-> Handler Value
deletePetByInt64R petId = notImplemented
-- | Finds Pets by status
--
-- Multiple status values can be provided with comma separated strings
-- operationId: findPetsByStatus
getPetFindByStatusR :: Handler Value
getPetFindByStatusR = notImplemented
-- | Finds Pets by tags
--
-- Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing.
-- operationId: findPetsByTags
getPetFindByTagsR :: Handler Value
getPetFindByTagsR = notImplemented
-- | Find pet by ID
--
-- Returns a single pet
-- operationId: getPetById
getPetByInt64R :: Int64 -- ^ ID of pet to return
-> Handler Value
getPetByInt64R petId = notImplemented
-- | Update an existing pet
--
-- operationId: updatePet
putPetR :: Handler Value
putPetR = notImplemented
-- | Updates a pet in the store with form data
--
-- operationId: updatePetWithForm
postPetByInt64R :: Int64 -- ^ ID of pet that needs to be updated
-> Handler Value
postPetByInt64R petId = notImplemented
-- | uploads an image
--
-- operationId: uploadFile
postPetByInt64UploadImageR :: Int64 -- ^ ID of pet to update
-> Handler Value
postPetByInt64UploadImageR petId = notImplemented

View File

@ -0,0 +1,35 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Handler.Store where
import Import
-- | Delete purchase order by ID
--
-- For valid response try integer IDs with value &lt; 1000. Anything above 1000 or nonintegers will generate API errors
-- operationId: deleteOrder
deleteStoreOrderByTextR :: Text -- ^ ID of the order that needs to be deleted
-> Handler Value
deleteStoreOrderByTextR orderId = notImplemented
-- | Returns pet inventories by status
--
-- Returns a map of status codes to quantities
-- operationId: getInventory
getStoreInventoryR :: Handler Value
getStoreInventoryR = notImplemented
-- | Find purchase order by ID
--
-- For valid response try integer IDs with value &lt;&#x3D; 5 or &gt; 10. Other values will generated exceptions
-- operationId: getOrderById
getStoreOrderByInt64R :: Int64 -- ^ ID of pet that needs to be fetched
-> Handler Value
getStoreOrderByInt64R orderId = notImplemented
-- | Place an order for a pet
--
-- operationId: placeOrder
postStoreOrderR :: Handler Value
postStoreOrderR = notImplemented

View File

@ -0,0 +1,60 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Handler.User where
import Import
-- | Create user
--
-- This can only be done by the logged in user.
-- operationId: createUser
postUserR :: Handler Value
postUserR = notImplemented
-- | Creates list of users with given input array
--
-- operationId: createUsersWithArrayInput
postUserCreateWithArrayR :: Handler Value
postUserCreateWithArrayR = notImplemented
-- | Creates list of users with given input array
--
-- operationId: createUsersWithListInput
postUserCreateWithListR :: Handler Value
postUserCreateWithListR = notImplemented
-- | Delete user
--
-- This can only be done by the logged in user.
-- operationId: deleteUser
deleteUserByTextR :: Text -- ^ The name that needs to be deleted
-> Handler Value
deleteUserByTextR username = notImplemented
-- | Get user by user name
--
-- operationId: getUserByName
getUserByTextR :: Text -- ^ The name that needs to be fetched. Use user1 for testing.
-> Handler Value
getUserByTextR username = notImplemented
-- | Logs user into the system
--
-- operationId: loginUser
getUserLoginR :: Handler Value
getUserLoginR = notImplemented
-- | Logs out current logged in user session
--
-- operationId: logoutUser
getUserLogoutR :: Handler Value
getUserLogoutR = notImplemented
-- | Updated user
--
-- This can only be done by the logged in user.
-- operationId: updateUser
putUserByTextR :: Text -- ^ name that need to be deleted
-> Handler Value
putUserByTextR username = notImplemented

View File

@ -0,0 +1,6 @@
module Import
( module Import
) where
import Foundation as Import
import Import.NoFoundation as Import

View File

@ -0,0 +1,11 @@
{-# LANGUAGE CPP #-}
module Import.NoFoundation
( module Import
) where
import ClassyPrelude.Yesod as Import
import Error as Import
import Settings as Import
-- import Settings.StaticFiles as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import

View File

@ -0,0 +1,173 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
module OpenAPIPetstore.Types (
ApiResponse (..),
Category (..),
Order (..),
Pet (..),
Tag (..),
User (..),
) where
import ClassyPrelude.Yesod
import Data.Foldable (foldl)
import Data.Maybe (fromMaybe)
import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
import Data.Aeson.Types (Options(..), defaultOptions)
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Function ((&))
-- | Describes the result of uploading an image resource
data ApiResponse = ApiResponse
{ apiResponseCode :: Maybe Int -- ^
, apiResponseType :: Maybe Text -- ^
, apiResponseMessage :: Maybe Text -- ^
} deriving (Show, Eq, Generic)
instance FromJSON ApiResponse where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse")
instance ToJSON ApiResponse where
toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse")
-- | A category for a pet
data Category = Category
{ categoryId :: Maybe Int64 -- ^
, categoryName :: Maybe Text -- ^
} deriving (Show, Eq, Generic)
instance FromJSON Category where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "category")
instance ToJSON Category where
toJSON = genericToJSON (removeFieldLabelPrefix False "category")
-- | An order for a pets from the pet store
data Order = Order
{ orderId :: Maybe Int64 -- ^
, orderPetId :: Maybe Int64 -- ^
, orderQuantity :: Maybe Int -- ^
, orderShipDate :: Maybe UTCTime -- ^
, orderStatus :: Maybe Text -- ^ Order Status
, orderComplete :: Maybe Bool -- ^
} deriving (Show, Eq, Generic)
instance FromJSON Order where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "order")
instance ToJSON Order where
toJSON = genericToJSON (removeFieldLabelPrefix False "order")
-- | A pet for sale in the pet store
data Pet = Pet
{ petId :: Maybe Int64 -- ^
, petCategory :: Maybe Category -- ^
, petName :: Text -- ^
, petPhotoUrls :: [Text] -- ^
, petTags :: Maybe [Tag] -- ^
, petStatus :: Maybe Text -- ^ pet status in the store
} deriving (Show, Eq, Generic)
instance FromJSON Pet where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet")
instance ToJSON Pet where
toJSON = genericToJSON (removeFieldLabelPrefix False "pet")
-- | A tag for a pet
data Tag = Tag
{ tagId :: Maybe Int64 -- ^
, tagName :: Maybe Text -- ^
} deriving (Show, Eq, Generic)
instance FromJSON Tag where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag")
instance ToJSON Tag where
toJSON = genericToJSON (removeFieldLabelPrefix False "tag")
-- | A User who is purchasing from the pet store
data User = User
{ userId :: Maybe Int64 -- ^
, userUsername :: Maybe Text -- ^
, userFirstName :: Maybe Text -- ^
, userLastName :: Maybe Text -- ^
, userEmail :: Maybe Text -- ^
, userPassword :: Maybe Text -- ^
, userPhone :: Maybe Text -- ^
, userUserStatus :: Maybe Int -- ^ User Status
} deriving (Show, Eq, Generic)
instance FromJSON User where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "user")
instance ToJSON User where
toJSON = genericToJSON (removeFieldLabelPrefix False "user")
uncapitalize :: String -> String
uncapitalize (c : cs) = Char.toLower c : cs
uncapitalize [] = []
-- | Remove a field label prefix during JSON parsing.
-- Also perform any replacements for special characters.
-- The @forParsing@ parameter is to distinguish between the cases in which we're using this
-- to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want
-- to replace special characters with their quoted equivalents (because we cannot have special
-- chars in identifier names), while we want to do viceversa when sending data instead.
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix =
defaultOptions
{ omitNothingFields = True
, fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
}
where
replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
specialChars =
[ ("@", "'At")
, ("\\", "'Back_Slash")
, ("<=", "'Less_Than_Or_Equal_To")
, ("\"", "'Double_Quote")
, ("[", "'Left_Square_Bracket")
, ("]", "'Right_Square_Bracket")
, ("^", "'Caret")
, ("_", "'Underscore")
, ("`", "'Backtick")
, ("!", "'Exclamation")
, ("#", "'Hash")
, ("$", "'Dollar")
, ("%", "'Percent")
, ("&", "'Ampersand")
, ("'", "'Quote")
, ("(", "'Left_Parenthesis")
, (")", "'Right_Parenthesis")
, ("*", "'Star")
, ("+", "'Plus")
, (",", "'Comma")
, ("-", "'Dash")
, (".", "'Period")
, ("/", "'Slash")
, (":", "'Colon")
, ("{", "'Left_Curly_Bracket")
, ("|", "'Pipe")
, ("<", "'LessThan")
, ("!=", "'Not_Equal")
, ("=", "'Equal")
, ("}", "'Right_Curly_Bracket")
, (">", "'GreaterThan")
, ("~", "'Tilde")
, ("?", "'Question_Mark")
, (">=", "'Greater_Than_Or_Equal_To")
, ("~=", "'Tilde_Equal")
]
mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
replacer =
if forParsing
then flip T.replace
else T.replace

View File

@ -0,0 +1,86 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module Settings where
import ClassyPrelude.Yesod
import qualified Control.Exception as Exception
import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
(.:?))
import Data.FileEmbed (embedFile)
import Data.Yaml (decodeEither')
import Network.Wai.Handler.Warp (HostPreference)
import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
data AppSettings = AppSettings
{ appStaticDir :: String
-- ^ Directory from which to serve static files.
, appRoot :: Maybe Text
-- ^ Base for all generated URLs. If @Nothing@, determined
-- from the request headers.
, appHost :: HostPreference
-- ^ Host/interface the server should bind to.
, appPort :: Int
-- ^ Port to listen on
, appIpFromHeader :: Bool
-- ^ Get the IP address from the header when logging. Useful when sitting
-- behind a reverse proxy.
, appDetailedRequestLogging :: Bool
-- ^ Use detailed request logging system
, appShouldLogAll :: Bool
-- ^ Should all log messages be displayed?
, appMutableStatic :: Bool
-- ^ Assume that files in the static dir may change after compilation
}
instance FromJSON AppSettings where
parseJSON = withObject "AppSettings" $ \o -> do
let defaultDev =
#ifdef DEVELOPMENT
True
#else
False
#endif
appStaticDir <- o .: "static-dir"
appRoot <- o .:? "approot"
appHost <- fromString <$> o .: "host"
appPort <- o .: "port"
appIpFromHeader <- o .: "ip-from-header"
dev <- o .:? "development" .!= defaultDev
appDetailedRequestLogging <- o .:? "detailed-logging" .!= dev
appShouldLogAll <- o .:? "should-log-all" .!= dev
appMutableStatic <- o .:? "mutable-static" .!= dev
return AppSettings {..}
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- | Raw bytes at compile time of @config/settings.yml@
configSettingsYmlBS :: ByteString
configSettingsYmlBS = $(embedFile configSettingsYml)
-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue :: Value
configSettingsYmlValue = either Exception.throw id
$ decodeEither' configSettingsYmlBS
-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings :: AppSettings
compileTimeAppSettings =
case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
Error e -> error e
Success settings -> settings

View File

@ -0,0 +1,21 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Settings.StaticFiles where
import Settings (appStaticDir, compileTimeAppSettings)
import Yesod.Static (staticFiles)
-- This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
--
-- For example, to refer to @static/js/script.js@ via an identifier, you'd use:
--
-- js_script_js
--
-- If the identifier is not available, you may use:
--
-- StaticFile ["js", "script.js"] []
staticFiles (appStaticDir compileTimeAppSettings)

View File

@ -0,0 +1,67 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

View File

@ -0,0 +1,49 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.PetSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
describe "postPetR" $
it "returns 501 Not Implemented" $ do
post PetR
statusIs 501
describe "deletePetByInt64R" $
it "returns 501 Not Implemented" $ do
performMethod "DELETE" $ PetByInt64R 789
statusIs 501
describe "getPetFindByStatusR" $
it "returns 501 Not Implemented" $ do
get PetFindByStatusR
statusIs 501
describe "getPetFindByTagsR" $
it "returns 501 Not Implemented" $ do
get PetFindByTagsR
statusIs 501
describe "getPetByInt64R" $
it "returns 501 Not Implemented" $ do
get $ PetByInt64R 789
statusIs 501
describe "putPetR" $
it "returns 501 Not Implemented" $ do
performMethod "PUT" PetR
statusIs 501
describe "postPetByInt64R" $
it "returns 501 Not Implemented" $ do
post $ PetByInt64R 789
statusIs 501
describe "postPetByInt64UploadImageR" $
it "returns 501 Not Implemented" $ do
post $ PetByInt64UploadImageR 789
statusIs 501

View File

@ -0,0 +1,29 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.StoreSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
describe "deleteStoreOrderByTextR" $
it "returns 501 Not Implemented" $ do
performMethod "DELETE" $ StoreOrderByTextR "orderId_example"
statusIs 501
describe "getStoreInventoryR" $
it "returns 501 Not Implemented" $ do
get StoreInventoryR
statusIs 501
describe "getStoreOrderByInt64R" $
it "returns 501 Not Implemented" $ do
get $ StoreOrderByInt64R 789
statusIs 501
describe "postStoreOrderR" $
it "returns 501 Not Implemented" $ do
post StoreOrderR
statusIs 501

View File

@ -0,0 +1,49 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.UserSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
describe "postUserR" $
it "returns 501 Not Implemented" $ do
post UserR
statusIs 501
describe "postUserCreateWithArrayR" $
it "returns 501 Not Implemented" $ do
post UserCreateWithArrayR
statusIs 501
describe "postUserCreateWithListR" $
it "returns 501 Not Implemented" $ do
post UserCreateWithListR
statusIs 501
describe "deleteUserByTextR" $
it "returns 501 Not Implemented" $ do
performMethod "DELETE" $ UserByTextR "username_example"
statusIs 501
describe "getUserByTextR" $
it "returns 501 Not Implemented" $ do
get $ UserByTextR "username_example"
statusIs 501
describe "getUserLoginR" $
it "returns 501 Not Implemented" $ do
get UserLoginR
statusIs 501
describe "getUserLogoutR" $
it "returns 501 Not Implemented" $ do
get UserLogoutR
statusIs 501
describe "putUserByTextR" $
it "returns 501 Not Implemented" $ do
performMethod "PUT" $ UserByTextR "username_example"
statusIs 501

View File

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

View File

@ -0,0 +1,31 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module TestImport
( module TestImport
, module X
) where
import Application (makeFoundation, makeLogWare)
import ClassyPrelude as X hiding (Handler)
import Foundation as X
import Test.Hspec as X
import Yesod.Default.Config2 (useEnv, loadYamlSettings)
import Yesod.Test as X
import Yesod.Core.Unsafe (fakeHandlerGetLogger)
runHandler :: Handler a -> YesodExample App a
runHandler handler = do
app <- getTestYesod
fakeHandlerGetLogger appLogger app handler
withApp :: SpecWith (TestApp App) -> Spec
withApp = before $ do
settings <- loadYamlSettings
["config/test-settings.yml", "config/settings.yml"]
[]
useEnv
foundation <- makeFoundation settings
logWare <- liftIO $ makeLogWare foundation
return (foundation, logWare)