diff --git a/bin/configs/haskell-yesod-petstore-new.yaml b/bin/configs/haskell-yesod-petstore-new.yaml new file mode 100644 index 00000000000..f7ae3890cdf --- /dev/null +++ b/bin/configs/haskell-yesod-petstore-new.yaml @@ -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" diff --git a/docs/generators/haskell-yesod.md b/docs/generators/haskell-yesod.md new file mode 100644 index 00000000000..415a6f00623 --- /dev/null +++ b/docs/generators/haskell-yesod.md @@ -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.|
**false**
The 'additionalProperties' implementation is compliant with the OAS and JSON schema specifications.
**true**
Keep the old (incorrect) behaviour that 'additionalProperties' is set to false by default.
|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).|
**true**
The mapping in the discriminator includes descendent schemas that allOf inherit from self and the discriminator mapping schemas in the OAS document.
**false**
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.
|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 "openapi-haskell-yesod-server")| |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 + + + +## RESERVED WORDS + + + +## 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 diff --git a/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java new file mode 100644 index 00000000000..e09edd61bcd --- /dev/null +++ b/modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellYesodServerCodegen.java @@ -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( + 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/ (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> replacements = new ArrayList<>(); + Object[] replacementChars = specialCharReplacements.keySet().toArray(); + for (Object replacementChar : replacementChars) { + String c = (String) replacementChar; + Map 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 pathToComponents(String path, List pathParams) { + // Map the capture params by their names. + HashMap captureTypes = new HashMap(); + 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 components = new ArrayList(); + 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 pathParams) { + return "/" + String.join("/", pathToComponents(path, pathParams)); + } + + private String pathToYesodResource(String path, List 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 servers) { + CodegenOperation op = super.fromOperation(resourcePath, httpMethod, operation, servers); + + String path = pathToYesodPath(op.path, op.pathParams); + String resource = pathToYesodResource(op.path, op.pathParams); + + List > routes = (List >) additionalProperties.get("routes"); + if (routes == null) { + routes = new ArrayList>(); + 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 route : routes) { + if (path.equals(route.get("path"))) { + List methods = (List) route.get("methods"); + methods.add(op.httpMethod); + found = true; + break; + } + } + + if (!found) { + Map route = new HashMap(); + route.put("path", path); + route.put("resource", resource); + List methods = new ArrayList(); + 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 > routes) { + for (Map 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(); + } + } + } +} diff --git a/modules/openapi-generator/src/main/resources/META-INF/services/org.openapitools.codegen.CodegenConfig b/modules/openapi-generator/src/main/resources/META-INF/services/org.openapitools.codegen.CodegenConfig index df636589cd5..78855ce50ad 100644 --- a/modules/openapi-generator/src/main/resources/META-INF/services/org.openapitools.codegen.CodegenConfig +++ b/modules/openapi-generator/src/main/resources/META-INF/services/org.openapitools.codegen.CodegenConfig @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/README.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/README.mustache new file mode 100644 index 00000000000..27cd1c0b76c --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/README.mustache @@ -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 ` 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. diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/api.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/api.mustache new file mode 100644 index 00000000000..f8728dad3ea --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/api.mustache @@ -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}} diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/api_test.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/api_test.mustache new file mode 100644 index 00000000000..3a264f97f3e --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/api_test.mustache @@ -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}} diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/app/DevelMain.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/app/DevelMain.mustache new file mode 100644 index 00000000000..ef62d87f4b9 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/app/DevelMain.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/app/devel.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/app/devel.mustache new file mode 100644 index 00000000000..7d2da38507f --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/app/devel.mustache @@ -0,0 +1,6 @@ +{-# LANGUAGE PackageImports #-} +import "{{projectName}}" Application (develMain) +import Prelude (IO) + +main :: IO () +main = develMain diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/app/main.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/app/main.hs new file mode 100644 index 00000000000..4ffa93d41c4 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/app/main.hs @@ -0,0 +1,5 @@ +import Prelude (IO) +import Application (appMain) + +main :: IO () +main = appMain diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/config/keter.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/config/keter.mustache new file mode 100644 index 00000000000..a570e37b8cd --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/config/keter.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/config/routes.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/config/routes.mustache new file mode 100644 index 00000000000..4737e6dc4dd --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/config/routes.mustache @@ -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}} diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/config/settings.yml b/modules/openapi-generator/src/main/resources/haskell-yesod/config/settings.yml new file mode 100644 index 00000000000..26b9a74eda9 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/config/settings.yml @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/config/test-settings.yml b/modules/openapi-generator/src/main/resources/haskell-yesod/config/test-settings.yml new file mode 100644 index 00000000000..0967ef424bc --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/config/test-settings.yml @@ -0,0 +1 @@ +{} diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/dir-locals.el b/modules/openapi-generator/src/main/resources/haskell-yesod/dir-locals.el new file mode 100644 index 00000000000..a44395f88b6 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/dir-locals.el @@ -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)))) diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/gitignore.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/gitignore.mustache new file mode 100644 index 00000000000..b754bc55ee5 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/gitignore.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/package.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/package.mustache new file mode 100644 index 00000000000..b09357656a4 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/package.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache new file mode 100644 index 00000000000..3658d55833d --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/API/Types.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Application.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Application.mustache new file mode 100644 index 00000000000..c04f1061382 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Application.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Error.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Error.hs new file mode 100644 index 00000000000..8e434933e87 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Error.hs @@ -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" diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Foundation.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Foundation.hs new file mode 100644 index 00000000000..1ac3a4b5b0c --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Foundation.hs @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import.hs new file mode 100644 index 00000000000..a1020015638 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import.hs @@ -0,0 +1,6 @@ +module Import + ( module Import + ) where + +import Foundation as Import +import Import.NoFoundation as Import diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import/NoFoundation.mustache b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import/NoFoundation.mustache new file mode 100644 index 00000000000..8864ad39d0f --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Import/NoFoundation.mustache @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings.hs new file mode 100644 index 00000000000..1c0e5cac07e --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings.hs @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings/StaticFiles.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings/StaticFiles.hs new file mode 100644 index 00000000000..0cefeaa1d6a --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/src/Settings/StaticFiles.hs @@ -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) diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/stack.yaml b/modules/openapi-generator/src/main/resources/haskell-yesod/stack.yaml new file mode 100644 index 00000000000..eaf9096c163 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/stack.yaml @@ -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 diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/static/gitkeep b/modules/openapi-generator/src/main/resources/haskell-yesod/static/gitkeep new file mode 100644 index 00000000000..e69de29bb2d diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/test/Spec.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/test/Spec.hs new file mode 100644 index 00000000000..a824f8c30c8 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/modules/openapi-generator/src/main/resources/haskell-yesod/test/TestImport.hs b/modules/openapi-generator/src/main/resources/haskell-yesod/test/TestImport.hs new file mode 100644 index 00000000000..91dd7db1fb4 --- /dev/null +++ b/modules/openapi-generator/src/main/resources/haskell-yesod/test/TestImport.hs @@ -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) diff --git a/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerCodegenTest.java b/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerCodegenTest.java new file mode 100644 index 00000000000..830c159f08d --- /dev/null +++ b/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerCodegenTest.java @@ -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> toRoutes(String... paths) { + List> routes = new ArrayList>(); + for (String path : paths) { + Map route = new HashMap(); + route.put("path", path); + routes.add(route); + } + return routes; + } +} diff --git a/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerOptionsTest.java b/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerOptionsTest.java new file mode 100644 index 00000000000..07d317b23da --- /dev/null +++ b/modules/openapi-generator/src/test/java/org/openapitools/codegen/haskellyesod/HaskellYesodServerOptionsTest.java @@ -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); + } +} diff --git a/modules/openapi-generator/src/test/java/org/openapitools/codegen/options/HaskellYesodServerOptionsProvider.java b/modules/openapi-generator/src/test/java/org/openapitools/codegen/options/HaskellYesodServerOptionsProvider.java new file mode 100644 index 00000000000..230c2243a80 --- /dev/null +++ b/modules/openapi-generator/src/test/java/org/openapitools/codegen/options/HaskellYesodServerOptionsProvider.java @@ -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 createOptions() { + ImmutableMap.Builder builder = new ImmutableMap.Builder(); + 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; + } +} diff --git a/samples/server/petstore/haskell-yesod/.dir-locals.el b/samples/server/petstore/haskell-yesod/.dir-locals.el new file mode 100644 index 00000000000..a44395f88b6 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/.dir-locals.el @@ -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)))) diff --git a/samples/server/petstore/haskell-yesod/.gitignore b/samples/server/petstore/haskell-yesod/.gitignore new file mode 100644 index 00000000000..85cf0acb96d --- /dev/null +++ b/samples/server/petstore/haskell-yesod/.gitignore @@ -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 diff --git a/samples/server/petstore/haskell-yesod/.openapi-generator-ignore b/samples/server/petstore/haskell-yesod/.openapi-generator-ignore new file mode 100644 index 00000000000..7484ee590a3 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/.openapi-generator-ignore @@ -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 diff --git a/samples/server/petstore/haskell-yesod/.openapi-generator/FILES b/samples/server/petstore/haskell-yesod/.openapi-generator/FILES new file mode 100644 index 00000000000..1f055028bf6 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/.openapi-generator/FILES @@ -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 diff --git a/samples/server/petstore/haskell-yesod/.openapi-generator/VERSION b/samples/server/petstore/haskell-yesod/.openapi-generator/VERSION new file mode 100644 index 00000000000..4b448de535c --- /dev/null +++ b/samples/server/petstore/haskell-yesod/.openapi-generator/VERSION @@ -0,0 +1 @@ +5.3.0-SNAPSHOT \ No newline at end of file diff --git a/samples/server/petstore/haskell-yesod/README.md b/samples/server/petstore/haskell-yesod/README.md new file mode 100644 index 00000000000..41b8c965687 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/README.md @@ -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 ` 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. diff --git a/samples/server/petstore/haskell-yesod/app/DevelMain.hs b/samples/server/petstore/haskell-yesod/app/DevelMain.hs new file mode 100644 index 00000000000..9883fc3ce66 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/app/DevelMain.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/app/devel.hs b/samples/server/petstore/haskell-yesod/app/devel.hs new file mode 100644 index 00000000000..46546ceb555 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/app/devel.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PackageImports #-} +import "open-api-petstore" Application (develMain) +import Prelude (IO) + +main :: IO () +main = develMain diff --git a/samples/server/petstore/haskell-yesod/app/main.hs b/samples/server/petstore/haskell-yesod/app/main.hs new file mode 100644 index 00000000000..4ffa93d41c4 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/app/main.hs @@ -0,0 +1,5 @@ +import Prelude (IO) +import Application (appMain) + +main :: IO () +main = appMain diff --git a/samples/server/petstore/haskell-yesod/config/keter.yml b/samples/server/petstore/haskell-yesod/config/keter.yml new file mode 100644 index 00000000000..882f2a75d1a --- /dev/null +++ b/samples/server/petstore/haskell-yesod/config/keter.yml @@ -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 diff --git a/samples/server/petstore/haskell-yesod/config/routes.yesodroutes b/samples/server/petstore/haskell-yesod/config/routes.yesodroutes new file mode 100644 index 00000000000..e040781920f --- /dev/null +++ b/samples/server/petstore/haskell-yesod/config/routes.yesodroutes @@ -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 diff --git a/samples/server/petstore/haskell-yesod/config/settings.yml b/samples/server/petstore/haskell-yesod/config/settings.yml new file mode 100644 index 00000000000..26b9a74eda9 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/config/settings.yml @@ -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 diff --git a/samples/server/petstore/haskell-yesod/config/test-settings.yml b/samples/server/petstore/haskell-yesod/config/test-settings.yml new file mode 100644 index 00000000000..0967ef424bc --- /dev/null +++ b/samples/server/petstore/haskell-yesod/config/test-settings.yml @@ -0,0 +1 @@ +{} diff --git a/samples/server/petstore/haskell-yesod/package.yaml b/samples/server/petstore/haskell-yesod/package.yaml new file mode 100644 index 00000000000..175de2b3ac5 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/package.yaml @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Application.hs b/samples/server/petstore/haskell-yesod/src/Application.hs new file mode 100644 index 00000000000..90f4b4a7a17 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Application.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Error.hs b/samples/server/petstore/haskell-yesod/src/Error.hs new file mode 100644 index 00000000000..8e434933e87 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Error.hs @@ -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" diff --git a/samples/server/petstore/haskell-yesod/src/Foundation.hs b/samples/server/petstore/haskell-yesod/src/Foundation.hs new file mode 100644 index 00000000000..1ac3a4b5b0c --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Foundation.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Handler/Pet.hs b/samples/server/petstore/haskell-yesod/src/Handler/Pet.hs new file mode 100644 index 00000000000..d96b391f0cf --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Handler/Pet.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Handler/Store.hs b/samples/server/petstore/haskell-yesod/src/Handler/Store.hs new file mode 100644 index 00000000000..66cbc157555 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Handler/Store.hs @@ -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 < 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 <= 5 or > 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 diff --git a/samples/server/petstore/haskell-yesod/src/Handler/User.hs b/samples/server/petstore/haskell-yesod/src/Handler/User.hs new file mode 100644 index 00000000000..142d051b429 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Handler/User.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Import.hs b/samples/server/petstore/haskell-yesod/src/Import.hs new file mode 100644 index 00000000000..a1020015638 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Import.hs @@ -0,0 +1,6 @@ +module Import + ( module Import + ) where + +import Foundation as Import +import Import.NoFoundation as Import diff --git a/samples/server/petstore/haskell-yesod/src/Import/NoFoundation.hs b/samples/server/petstore/haskell-yesod/src/Import/NoFoundation.hs new file mode 100644 index 00000000000..8864ad39d0f --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Import/NoFoundation.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs b/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs new file mode 100644 index 00000000000..ab0cb00e1ba --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Settings.hs b/samples/server/petstore/haskell-yesod/src/Settings.hs new file mode 100644 index 00000000000..1c0e5cac07e --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Settings.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/src/Settings/StaticFiles.hs b/samples/server/petstore/haskell-yesod/src/Settings/StaticFiles.hs new file mode 100644 index 00000000000..0cefeaa1d6a --- /dev/null +++ b/samples/server/petstore/haskell-yesod/src/Settings/StaticFiles.hs @@ -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) diff --git a/samples/server/petstore/haskell-yesod/stack.yaml b/samples/server/petstore/haskell-yesod/stack.yaml new file mode 100644 index 00000000000..eaf9096c163 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/stack.yaml @@ -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 diff --git a/samples/server/petstore/haskell-yesod/static/.gitkeep b/samples/server/petstore/haskell-yesod/static/.gitkeep new file mode 100644 index 00000000000..e69de29bb2d diff --git a/samples/server/petstore/haskell-yesod/test/Handler/PetSpec.hs b/samples/server/petstore/haskell-yesod/test/Handler/PetSpec.hs new file mode 100644 index 00000000000..e063cad4809 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/test/Handler/PetSpec.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/test/Handler/StoreSpec.hs b/samples/server/petstore/haskell-yesod/test/Handler/StoreSpec.hs new file mode 100644 index 00000000000..f3685dfa527 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/test/Handler/StoreSpec.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/test/Handler/UserSpec.hs b/samples/server/petstore/haskell-yesod/test/Handler/UserSpec.hs new file mode 100644 index 00000000000..e2da9276063 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/test/Handler/UserSpec.hs @@ -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 diff --git a/samples/server/petstore/haskell-yesod/test/Spec.hs b/samples/server/petstore/haskell-yesod/test/Spec.hs new file mode 100644 index 00000000000..a824f8c30c8 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/samples/server/petstore/haskell-yesod/test/TestImport.hs b/samples/server/petstore/haskell-yesod/test/TestImport.hs new file mode 100644 index 00000000000..91dd7db1fb4 --- /dev/null +++ b/samples/server/petstore/haskell-yesod/test/TestImport.hs @@ -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)