hopper.gr

/**
 * @module Hopper: An HTTP microframework for the Grain programming language.
 * 
 * Version 0.1.0
 */

import Option from "option"
import Result from "result"
import Number from "number"
import Map from "map"
import List from "list"
import Array from "array"
import String from "string"
import Char from "char"
import Regex from "regex"
import Int64 from "int64"
import Marshal from "marshal"
import Process from "sys/process"
import File from "sys/file"
import Time from "sys/time"

/**
 * @section Types: Type declarations included in the Hopper module.
 */

/**
 * Represents various HTTP request methods.
 */
export enum Method {
  Get,
  Post,
  Put,
  Delete,
  Head,
  Patch,
  Options,
  Trace,
  Method(String),
}

/**
 * Represents either a single value or multiple values.
 */
export enum OneOrMany<a> {
  Val(a),
  Vals(List<a>),
}

// underscore prefix to discourage direct record field access

/**
 * Represents request-specific message data (this simply contains data
 * injected into `Message<a>` to make `Request` as `Message<RequestMsgData>`).
 * Typically you should not access the fields of this record directly.
 */
export record RequestMsgData {
  _wagiEnv: Map.Map<String, String>,
  _params: Map.Map<String, String>,
  _query: Map.Map<String, OneOrMany<String>>,
}

/**
 * Represents HTTP response statuses.
 */
export enum Status {
  // 1XX
  Continue,
  SwitchingProtocols,
  // 2XX
  HttpOk,
  Created,
  Accepted,
  NonAuthoritativeInformation,
  NoContent,
  ResetContent,
  ParialContent,
  // 3XX
  MultipleChoices,
  MovedPermanently,
  Found,
  SeeOther,
  NotModified,
  TemporaryRedirect,
  PermanentRedirect,
  // 4XX
  BadRequest,
  Unauthorized,
  PaymentRequired,
  Forbidden,
  NotFound,
  MethodNotAllowed,
  NotAcceptable,
  ProxyAuthenticationRequired,
  RequestTimeout,
  Conflict,
  Gone,
  LengthRequired,
  PreconditionFailed,
  PayloadTooLarge,
  UriTooLong,
  UnsupportedMediaType,
  RangeNotSatisfiable,
  ExpectationFailed,
  ImATeapot,
  MisdirectedRequest,
  TooEarly,
  UpgradeRequired,
  PrecoditionRequired,
  TooManyRequests,
  RequestHeaderFieldsTooLarge,
  UnavailableForLegalReasons,
  // 5XX
  InternalServerError,
  NotImplemented,
  BadGateway,
  ServiceUnavailable,
  GatewayTimeout,
  HttpVersionNotSupported,
  VariantAlsoNegotiates,
  NotExtended,
  NetworkAuthenticationRequired,
  // arbitrary status
  Status(Number),
}

/**
 * Represents response-specific message data (this simply contains data
 * injected into `Message<a>` to make `Response` as `Message<ResponseMsgData>`).
 * Typically you should not access the fields of this record directly.
 */
export record ResponseMsgData {
  _status: Status,
}

/**
 * Opaque polymorphic representation of an HTTP message (concretely instanced
 * by `Request` and `Response` types). Typically you should not access the
 * fields of this record directly.
 */
export record Message<a> {
  _message: a,
  _headers: Map.Map<String, String>,
  _body: String,
  _variables: Map.Map<String, Bytes>,
}

/**
 * Represents an HTTP request.
 */
export type Request = Message<RequestMsgData>

/**
 * Represents an HTTP response.
 */
export type Response = Message<ResponseMsgData>

/**
 * Represents an HTTP request handler which processes a request and returns a response.
 */
export type RequestHandler = Request -> Response

/**
 * Represents an HTTP middleware, which sits between the client and base request handler.
 */
export type Middleware = RequestHandler -> RequestHandler

// test-export
export enum RequestMethods {
  Methods(List<Method>),
  All,
}

/**
 * Represents a route on the server with a request handler attached to it.
 */
export record Route {
  path: String,
  routeHandler: RouteHandler,
},
enum RouteHandler {
  Endpoint(RequestMethods, RequestHandler),
  Scope(Middleware, List<Route>),
}

/**
 * Represents possible `Err` reasons for why a variable's value was not read.
 * 
 * `NotSet` indicates that a variable with the given name does not exist
 * 
 * `DeserializationError` indicates that the variable was unable to be
 * deserialized properly. The attached `String` gives the error reason
 */
export enum GetVariableError {
  NotSet,
  DeserializationError(String),
}

/**
 * Represents the result of fetching a message variable. A `Result` with an
 * `Ok` variant containing the value or `GetVariableError` `Err` variant.
 */
export type Variable<a> = Result<a, GetVariableError>

/**
 * Represents an option to apply globally to the server.
 * 
 * `NotFoundHandler` can be used to define a custom 404 Not Found handler
 * when a route is not matched.
 * 
 * `MethodNotAllowedHandler` can be used to defined a custom 405 method
 * Not Allowed handler for cases of method mismatches.
 */
export enum ServerOption {
  NotFoundHandler(RequestHandler),
  MethodNotAllowedHandler((List<Method>, Request) -> Response),
}

/**
 * @section Utilities: Miscellaneous utility functions.
 */

let genericErrMsg = "make sure you are running in a properly configured WAGI environment"
let failWithMsg = msg => fail "ERROR " ++ msg ++ "; " ++ genericErrMsg
let failWithMsgWithErr = (msg, err) =>
  fail "ERROR " ++
  msg ++
  "; " ++
  genericErrMsg ++
  "; err " ++
  toString(err)

/**
 * Writes a message to the WAGI log file.
 * 
 * @param val: The value to write out to the log
 */
export let log = val => {
  ignore(File.fdWrite(File.stderr, toString(val) ++ "\n"))
}

/**
 * Utility function to combine multiple middlewares into one function.
 * 
 * @param mws: The middlewares to combine
 * @returns A single middleware function, chaining the first middleware in the list down to the last
 */
export let middlewares: List<Middleware> -> Middleware = mws => handler => {
  List.reduceRight((mw, handler) => mw(handler), handler, mws)
}

// credit to https://github.com/deislabs/wagi-fileserver for the media types
let mediaTypes = Map.fromList(
  [
    ("txt", "text/plain"),
    ("md", "text/plain"),
    ("mdown", "text/plain"),
    ("htm", "text/html"),
    ("html", "text/html"),
    ("xhtml", "application/xhtml+xml"),
    ("xml", "application/xml"),
    ("css", "text/css"),
    ("ics", "text/calendar"),
    ("json", "application/json"),
    ("jsonld", "application/ld+json"),
    ("toml", "application/toml"),
    ("yaml", "application/yaml"),
    ("js", "text/javascript"),
    ("mjs", "text/javascript"),
    ("wasm", "application/wasm"),
    ("csv", "text/csv"),
    ("sh", "application/x-sh"),
    ("apng", "image/apng"),
    ("avif", "image/avif"),
    ("png", "image/png"),
    ("png", "image/png"),
    ("jpg", "image/jpeg"),
    ("jpeg", "image/jpeg"),
    ("pjpeg", "image/jpeg"),
    ("pjp", "image/jpeg"),
    ("jfif", "image/jpeg"),
    ("gif", "image/gif"),
    ("tif", "image/tiff"),
    ("tiff", "image/tiff"),
    ("webp", "image/webp"),
    ("svg", "image/svg+xml"),
    ("bmp", "image/bmp"),
    ("ico", "image/vnd.microsoft.icon"),
    ("aac", "audio/aac"),
    ("avi", "video/x-msvideo"),
    ("wav", "audio/wave"),
    ("webm", "video/webm"),
    ("mp3", "audio/mpeg"),
    ("mp4", "video/mp4"),
    ("mpeg", "video/mpeg"),
    ("oga", "audio/ogg"),
    ("ogv", "video/ogg"),
    ("ogx", "application/ogg"),
    ("ts", "video/mp2t"),
    ("bz2", "application/x-bzip2"),
    ("tbz", "application/x-bzip2"),
    ("tbz2", "application/x-bzip2"),
    ("gz", "application/gzip"),
    ("rar", "application/vnd.rar"),
    ("tar", "text/x-tar"),
    ("tgz", "application/gzip"),
    ("jar", "application/java-archive"),
    ("mpkg", "application/vnd.apple.installer+xml"),
    ("zip", "application/zip"),
    ("7z", "application/x-7z-compressed"),
    ("azw", "application/vnd.amazon.ebook"),
    ("bin", "application/octet-stream"),
    ("doc", "application/msword"),
    (
      "docx",
      "application/vnd.openxmlformats-officedocument.wordprocessingml.document",
    ),
    ("epub", "application/epub+zip"),
    ("odp", "application/vnd.oasis.opendocument.presentation"),
    ("ods", "application/vnd.oasis.opendocument.spreadsheet"),
    ("odt", "application/vnd.oasis.opendocument.text"),
    ("pdf", "application/pdf"),
    ("ppt", "application/vnd.ms-powerpoint"),
    (
      "pptx",
      "application/vnd.openxmlformats-officedocument.presentationml.presentation",
    ),
    ("rtf", "application/rtf"),
    ("vsd", "application/vnd.visio"),
    ("xls", "application/vnd.ms-excel"),
    (
      "xlsx",
      "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet",
    ),
    ("eot", "application/vnd.ms-fontobject"),
    ("otf", "font/otf"),
    ("ttf", "font/ttf"),
    ("woff", "font/woff"),
    ("woff2", "font/woff2"),
  ]
)

/**
 * Guesses the MIME type of a media file by its filename extension.
 * 
 * @param fileName: The filename to guess the MIME type of
 * @returns A MIME type string for the filename
 */
export let guessMimeType = fileName => {
  let default = "application/octet-stream"
  match (String.lastIndexOf(".", fileName)) {
    Some(i) => {
      let extension = String.slice(i + 1, String.length(fileName), fileName)
      Option.unwrapWithDefault(default, Map.get(extension, mediaTypes))
    },
    None => default,
  }
}

/**
 * Splits a map containing `OneOrMany` values into a list of key-value pairs;
 * an element is added for each value of `Vals` for a key.
 * 
 * @param map: The map with `OneOrMany` values to inspect
 * @returns A list of key-value pairs representing the map
 */
export let splitOneOrManyMap = map => {
  let vals = List.flatMap(((key, val)) => {
    match (val) {
      Val(val) => [(key, val)],
      Vals(vals) => List.map(val => (key, val), vals),
    }
  }, Map.toList(map))
  List.sort(compare, vals)
}

/**
 * Joins a list of key-value pairs into a map of `OneOrMany` values, where
 * multiple values corresponding to the same key are collated into the same
 * `Vals` variant.
 * 
 * @param map: The key-value pairs list to inspect
 * @returns A map representing the list of pairs
 */
export let joinOneOrManyMap = list => {
  let valMap = Map.make()
  List.forEach(((key, val)) => {
    let val = match (Map.get(key, valMap)) {
      None => Val(val),
      Some(Val(currVal)) => Vals([currVal, val]),
      Some(Vals(currVals)) => Vals(List.append(currVals, [val])),
    }
    Map.set(key, val, valMap)
  }, list)
  valMap
}

let replacePatternsWith = (str, re, replace) => {
  let strLen = String.length(str)
  let matchPositions = List.map((reMatch: Regex.MatchResult) =>
    Option.unwrap(reMatch.groupPosition(0)), Regex.findAll(re, str))
  let parts = List.zipWith(
    ((_, prevEnd), (currBegin, currEnd)) => {
      let before = String.slice(prevEnd, currBegin, str)
      let matched = String.slice(currBegin, currEnd, str)
      before ++ (if (matched != "") replace(matched) else "")
    },
    [(0, 0), ...matchPositions],
    List.append(matchPositions, [(strLen, strLen)])
  )
  List.join("", parts)
}

let toHexString = num => {
  match (num) {
    10 => "A",
    11 => "B",
    12 => "C",
    13 => "D",
    14 => "E",
    15 => "F",
    _ => toString(num),
  }
}

let toEncodeRegex = Result.unwrap(Regex.make("[:/?#\\[\\]@!$&'()*+,;=% ]"))
let pctEncodedRegex = Result.unwrap(Regex.make("%[0-9A-Fa-f]{2}"))

/**
 * Percent-encodes RFC 3986 reserved url characters (and space) in a string.
 * 
 * @param str: The string to encode
 * @returns A percent-encoding of the given string
 */
export let percentEncode = str => {
  let replaceFn = c => {
    let code = String.charCodeAt(0, c)
    let firstHex = code >> 4
    let secondHex = code % 16
    "%" ++ toString(firstHex) ++ toHexString(secondHex)
  }
  replacePatternsWith(str, toEncodeRegex, replaceFn)
}

/**
 * Decodes any percent-encoded characters in a string.
 * 
 * @param str: The string to decode
 * @returns A decoding of the given percent-encoded string
 */
export let percentDecode = str => {
  let replaceFn = pctEncoding => {
    // truncate percent
    let hex = String.slice(1, 3, pctEncoding)
    let code = Result.unwrap(Number.parseInt(hex, 16))
    Char.toString(Char.fromCode(code))
  }
  replacePatternsWith(str, pctEncodedRegex, replaceFn)
}

/**
 * Url-encodes a map of OneOrMany values into a single string.
 * 
 * @param urlVals: A map of OneOrMany values to url-encode
 * @returns A url-encoded string of the values
 */
export let urlEncode = urlVals => {
  let list = splitOneOrManyMap(urlVals)
  let parts = List.map(((key, val)) => {
    percentEncode(key) ++ "=" ++ percentEncode(val)
  }, list)
  List.join("&", parts)
}

let urlDecodeParts = parts => {
  let partKeyVals = List.map(part => {
    match (String.indexOf("=", part)) {
      // some parts may only have a key, set value to empty string in this case
      None => (part, ""),
      Some(i) => {
        let name = String.slice(0, i, part)
        let val = String.slice(i + 1, String.length(part), part)
        (percentDecode(name), percentDecode(val))
      },
    }
  }, parts)
  joinOneOrManyMap(partKeyVals)
}

/**
 * Decodes a url-encoded string into a map of OneOrMany values.
 * 
 * @param str: A url-encoded string
 * @returns A map of OneOrMany values containing the values of the encoded string
 */
export let urlDecode = str => {
  let parts = Array.toList(String.split("&", str))
  urlDecodeParts(parts)
}

let methodPairs = [
  (Get, "GET"),
  (Post, "POST"),
  (Put, "PUT"),
  (Delete, "DELETE"),
  (Head, "HEAD"),
  (Patch, "PATCH"),
  (Options, "OPTIONS"),
  (Trace, "TRACE"),
]

let methodToStringMap = Map.fromList(methodPairs)
let stringToMethodMap = Map.fromList(List.map(((a, b)) => (b, a), methodPairs))

/**
 * Converts a string to an HTTP `Method`.
 * 
 * @param str: The string to convert to a `Method`
 * @returns A `Method` representing the string
 * 
 * @example Hopper.stringToMethod("GET") // Method.Get
 */
export let stringToMethod = str => {
  match (Map.get(str, stringToMethodMap)) {
    Some(method) => method,
    None => Method(str),
  }
}

/**
 * Converts a `Method` to a string describing the method.
 * 
 * @param method: `Method` to stringify
 * @returns A string representing the `Method`
 */
export let methodToString = method => {
  match (method) {
    Method(str) => str,
    _ => Option.unwrap(Map.get(method, methodToStringMap)),
  }
}

let statusPairs = [
  (Continue, 100),
  (SwitchingProtocols, 101),
  (HttpOk, 200),
  (Created, 201),
  (Accepted, 202),
  (NonAuthoritativeInformation, 203),
  (NoContent, 204),
  (ResetContent, 205),
  (ParialContent, 206),
  (MultipleChoices, 300),
  (MovedPermanently, 301),
  (Found, 302),
  (SeeOther, 303),
  (NotModified, 304),
  (TemporaryRedirect, 307),
  (PermanentRedirect, 308),
  (BadRequest, 400),
  (Unauthorized, 401),
  (PaymentRequired, 402),
  (Forbidden, 403),
  (NotFound, 404),
  (MethodNotAllowed, 405),
  (NotAcceptable, 406),
  (ProxyAuthenticationRequired, 407),
  (RequestTimeout, 408),
  (Conflict, 409),
  (Gone, 410),
  (LengthRequired, 411),
  (PreconditionFailed, 412),
  (PayloadTooLarge, 413),
  (UriTooLong, 414),
  (UnsupportedMediaType, 415),
  (RangeNotSatisfiable, 416),
  (ExpectationFailed, 417),
  (ImATeapot, 418),
  (MisdirectedRequest, 421),
  (TooEarly, 425),
  (UpgradeRequired, 426),
  (PrecoditionRequired, 428),
  (TooManyRequests, 429),
  (RequestHeaderFieldsTooLarge, 431),
  (UnavailableForLegalReasons, 451),
  (InternalServerError, 500),
  (NotImplemented, 501),
  (BadGateway, 502),
  (ServiceUnavailable, 503),
  (GatewayTimeout, 504),
  (HttpVersionNotSupported, 505),
  (VariantAlsoNegotiates, 506),
  (NotExtended, 510),
  (NetworkAuthenticationRequired, 511),
]

let statusToCodeMap = Map.fromList(statusPairs)
let codeToStatusMap = Map.fromList(List.map(((a, b)) => (b, a), statusPairs))

/**
 * Converts a status code to its corresponding status.
 * 
 * @param status: A status code to convert to a `Status`
 * @returns A status representing the given code
 */
export let codeToStatus = code => {
  match (Map.get(code, codeToStatusMap)) {
    Some(status) => status,
    _ => Status(code),
  }
}

/**
 * Converts a response status to its corresponding status code.
 * 
 * @param status: A `Status` to get the status code of
 * @returns A status code for the response status
 */
export let statusToCode = status => {
  match (status) {
    Status(status) => status,
    _ => Option.unwrap(Map.get(status, statusToCodeMap)),
  }
}

let isStatusType = beginRange => status => {
  let code = statusToCode(status)
  let endRange = beginRange + 100
  code >= beginRange && code < endRange
}

/**
 * Determines if an HTTP status is informational i.e. has a 1XX code.
 * 
 * @param status: The status to examine
 * @returns `true` if the status has a 1XX status code or `false` otherwise
 */
export let isInformationalStatus = isStatusType(100)

/**
 * Determines if an HTTP status is successful i.e. has a 2XX code.
 * 
 * @param status: The status to examine
 * @returns `true` if the status has a 2XX status code or `false` otherwise
 */
export let isSuccessfulStatus = isStatusType(200)

/**
 * Determines if an HTTP status is a redirection i.e. has a 3XX code.
 * 
 * @param status: The status to examine
 * @returns `true` if the status has a 3XX status code or `false` otherwise
 */
export let isRedirectionStatus = isStatusType(300)

/**
 * Determines if an HTTP status is a client error i.e. has a 4XX code.
 * 
 * @param status: The status to examine
 * @returns `true` if the status has a 4XX status code or `false` otherwise
 */
export let isClientErrorStatus = isStatusType(400)

/**
 * Determines if an HTTP status is a server error i.e. has a 5XX code.
 * 
 * @param status: The status to examine
 * @returns `true` if the status has a 5XX status code or `false` otherwise
 */
export let isServerErrorStatus = isStatusType(500)

/**
 * @section Messages: Functions that can be used on both requests and responses
 */

let toLower = str => {
  String.implode(
    Array.map(c => {
      let code = Char.code(c)
      if (code >= 65 && code <= 90) Char.fromCode(code + 32) else c
    }, String.explode(str))
  )
}

let headerNormed = str => {
  let chars = String.explode(toLower(str))
  String.implode(Array.map(c => if (c == '_') '-' else c, chars))
}

/**
 * Fetches a header from the message.
 * 
 * @param key: The header to request
 * @param msg: The request or response to examine
 * @returns The header value requested
 */
export let header = (key, msg) => {
  let key = headerNormed(key)
  let headersList = Map.toList(msg._headers)
  let header = List.find(((k, val)) => headerNormed(k) == key, headersList)
  match (header) {
    Some((_, val)) => Some(val),
    None => None,
  }
}

/**
 * Fetches headers on a message.
 * 
 * @param msg: The request or response to examine
 * @returns The headers on the request or response, with header names all in lowercase
 */
export let headers = msg => {
  let headersList = Map.toList(msg._headers)
  Map.fromList(List.map(((key, val)) => (headerNormed(key), val), headersList))
}

/**
 * Fetches the message body as a string.
 * 
 * @param msg: The request or response to examine
 * @returns The body as a string
 */
export let body = msg => {
  msg._body
}

/**
 * Sets a variable on a message to a new arbitrary value.
 * 
 * @param key: The variable to set
 * @param value: The new value to give the variable
 * @param msg: The message to attach the variable to
 */
export let setVariable = (key, value, msg) => {
  Map.set(key, Marshal.marshal(value), msg._variables)
}

/**
 * Fetches the value of a variable set on a message. The result of this
 * function should be explicitly typed.
 * 
 * @param key: The variable to fetch
 * @param msg: The message to inspect
 * @returns The value of the variable requested
 */
export let variable = (key, msg) => {
  match (Map.get(key, msg._variables)) {
    Some(val) => {
      match (Marshal.unmarshal(val)) {
        Ok(val) => Ok(val),
        Err(err) => Err(DeserializationError(err)),
      }
    },
    None => Err(NotSet),
  }: Variable<a>
}

/**
 * @section Requests: Functions related to handling incoming requests.
 */

/**
 * Fetches a URL query parameter with the given name from a request.
 * 
 * @param key: The name of the parameter to fetch the value of
 * @param req: The request to fetch the query parameter from
 * @returns The value of the query parameter with the given name
 */
export let query = (key, req: Request) => {
  Option.map(val => match (val) {
    Val(val) => val,
    Vals([val, ..._]) => val,
    _ => fail "",
  }, Map.get(key, req._message._query))
}

/**
 * Fetches a list of values associated with the URL query parameter with the
 * given name.
 * 
 * @param key: The name of the parameter to fetch the value of
 * @param req: The request to fetch the query parameters from
 * @returns The list of values of the query parameter with the given name
 */
export let queryList = (key, req: Request) => {
  match (Map.get(key, req._message._query)) {
    None => [],
    Some(Val(val)) => [val],
    Some(Vals(vals)) => vals,
  }
}

/**
 * Fetches all URL query parameters.
 * 
 * @param req: The request to fetch the query parameters from
 * @returns All query parameters given
 */
export let queries = (req: Request) => {
  req._message._query
}

let getPath = wagiEnv => {
  match (Map.get("PATH_INFO", wagiEnv)) {
    Some(val) => val,
    None => failWithMsg("Did not find \"PATH_INFO\" in environment"),
  }
}

/**
 * Fetches the full path from the requested URL.
 * 
 * @param req: The request to examine
 * @returns The full path requested
 */
export let path = (req: Request) => {
  getPath(req._message._wagiEnv)
}

/**
 * Fetches a path parameter from the request.
 * 
 * @param key: The path parameter to fetch
 * @param req: The request to examine
 * @returns The path parameter requested
 */
export let param = (key, req: Request) => {
  let failMsg = "URL path param " ++ key ++ " does not exist on route"
  Option.expect(failMsg, Map.get(key, req._message._params))
}

let getReqMethod = wagiEnv => {
  match (Map.get("REQUEST_METHOD", wagiEnv)) {
    Some(reqMethod) => stringToMethod(reqMethod),
    _ => failWithMsg("Did not find \"REQUEST_METHOD\" in request"),
  }
}

/**
 * Fetches the HTTP method of the request.
 * 
 * @param req: The request to examine
 * @returns The HTTP method of the request.
 */
export let method = (req: Request) => {
  getReqMethod(req._message._wagiEnv)
}

/**
 * @section Responses: Functions related to handling outgoing responses.
 */

/**
 * Creates a new `Response` with a status, headers, and body.
 * 
 * @param status: The desired HTTP status
 * @param headers: The desired HTTP headers
 * @param body: The body string to create the `Response` with
 * @returns A new `Response` with the given values
 */
export let response = (status, headers, body) => {
  {
    _message: { _status: status, },
    _variables: Map.make(),
    _headers: headers,
    _body: body,
  }: Response
}

let ctHeader = contentType => Map.fromList([("Content-Type", contentType)])

/**
 * Creates a new OK `Response` with a text body and `"text/plain"` Content-Type.
 * 
 * @param body: The text body to create the `Response` with
 * @returns A new text `Response`
 */
export let text = body => response(HttpOk, ctHeader("text/plain"), body)

/**
 * Creates a new OK `Response` with a JSON string body and `"application/json"` Content-Type.
 * 
 * Note: the argument type will likely be changed to a more friendly JSON
 * representation once https://github.com/grain-lang/grain/pull/1133 gets
 * merged.
 * 
 * @param body: The JSON body to create the `Response` with
 * @returns A new JSON `Response`
 */
export let json = body => response(HttpOk, ctHeader("application/json"), body)

/**
 * Creates a new OK `Response` with the specified content type.
 * 
 * @param contentType: The Content-Type to set for the `Response`
 * @param body: The body of the response
 * @returns A new `Response` with the given content type
 */
export let contentType = (contentType, body) =>
  response(HttpOk, ctHeader(contentType), body)

/**
 * Creates a new `Response` from an existing response, but with the response status code changed.
 * 
 * @param status: The desired HTTP status
 * @param res: The base response
 * @returns A new `Response` with the desired HTTP status
 */
export let newStatus = (status, res: Response) => {
  let { _headers, _body, _ } = res
  response(status, _headers, _body)
}

/**
 * Creates a new `Response` from an existing response, but with the response headers changed.
 * 
 * @param headers: The desired HTTP headers
 * @param res: The base response
 * @returns A new `Response` with the desired HTTP headers
 */
export let newHeaders = (headers, res: Response) => {
  let { _message: { _status }, _body, _ } = res
  response(_status, headers, _body)
}

/**
 * Creates a new `Response` from an existing response, but with the response body changed.
 * 
 * @param body: The desired HTTP body
 * @param res: The base response
 * @returns A new `Response` with the desired HTTP body
 */
export let newBody = (body, res: Response) => {
  let { _message: { _status }, _headers, _ } = res
  response(_status, _headers, body)
}

/**
 * Creates a new `Response` from a static file on the server at the given path.
 * 
 * @param filePath: The path of the file to search for on the server
 * @returns A new "OK" `Response` if the file is found, or a "Not Found" reponse otherwise
 */
export let file = filePath => {
  let result = File.pathOpen(
    File.pwdfd,
    [],
    filePath,
    [],
    [File.FdFilestats, File.FdRead],
    [],
    []
  )

  match (result) {
    Err(_) => response(NotFound, ctHeader("text/plain"), "File Not Found"),
    Ok(fd) => {
      let stats = Result.unwrap(File.fdFilestats(fd))
      let fileSize = Int64.toNumber(stats.size)
      let (contents, _) = Result.unwrap(File.fdRead(fd, fileSize))
      File.fdClose(fd)

      response(HttpOk, ctHeader(guessMimeType(filePath)), contents)
    },
  }
}

/**
 * Creates a new redirection `Response` to another route on the server.
 * 
 * @param path: The local path to redirect to
 * @param req: The incoming `Request`
 * @returns A new redirection `Response` with status code "302 Found"
 */
export let redirectLocal = (path, req: Request) => {
  let item = key => Option.unwrap(Map.get(key, req._message._wagiEnv))
  let isHttps = String.startsWith("https://", item("X_FULL_URL"))
  let protocol = if (isHttps) "https://" else "http://"
  let baseUrl = protocol ++ item("SERVER_NAME") ++ ":" ++ item("SERVER_PORT")
  response(Found, Map.fromList([("Location", baseUrl ++ path)]), "")
}

/**
 * Creates a new redirection `Response` to an arbitrary URL.
 * 
 * @param url: The URL to redirect to
 * @returns A new redirection `Response` with status code "302 Found"
 */
export let redirectExternal = url =>
  response(Found, Map.fromList([("Location", url)]), "")

/**
 * Fetches the HTTP response status of a response.
 * 
 * @param res: The response to examine
 * @returns The status of the response
 */
export let status = (res: Response) => {
  res._message._status
}

/**
 * @section Routing: Functions related to routing.
 */

let createRoute = (path, methods, handler) => {
  { path, routeHandler: Endpoint(methods, handler) }
}

/**
 * Creates a new `Route` for handling GET requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling GET requests at a path
 */
export let get = (path, handler) => {
  createRoute(path, Methods([Get]), handler)
}

/**
 * Creates a new `Route` for handling POST requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling POST requests at a path
 */
export let post = (path, handler) => {
  createRoute(path, Methods([Post]), handler)
}

/**
 * Creates a new `Route` for handling PUT requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling PUT requests at a path
 */
export let put = (path, handler) => {
  createRoute(path, Methods([Put]), handler)
}

/**
 * Creates a new `Route` for handling DELETE requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling DELETE requests at a path
 */
export let delete = (path, handler) => {
  createRoute(path, Methods([Delete]), handler)
}

/**
 * Creates a new `Route` for handling HEAD requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling HEAD requests at a path
 */
export let head = (path, handler) => {
  createRoute(path, Methods([Head]), handler)
}

/**
 * Creates a new `Route` for handling PATCH requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling PATCH requests at a path
 */
export let patch = (path, handler) => {
  createRoute(path, Methods([Patch]), handler)
}

/**
 * Creates a new `Route` for handling OPTIONS requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling OPTIONS requests at a path
 */
export let options = (path, handler) => {
  createRoute(path, Methods([Options]), handler)
}

/**
 * Creates a new `Route` for handling TRACE requests at a path.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling TRACE requests at a path
 */
export let trace = (path, handler) => {
  createRoute(path, Methods([Trace]), handler)
}

/**
 * Creates a new `Route` for handling requests at a path.
 * 
 * @param method: The HTTP method the route will handle
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling requests at a path
 */
export let route = (method, path, handler) => {
  createRoute(path, Methods([method]), handler)
}

/**
 * Creates a new `Route` for handling requests at a path with multiple allowed HTTP methods.
 * 
 * @param methods: The HTTP methods the route will handle
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling requests at a path
 */
export let methodsRoute = (methods, path, handler) => {
  createRoute(path, Methods(methods), handler)
}

/**
 * Creates a new `Route` for handling requests at a path for all HTTP methods.
 * 
 * @param path: The relative path the request handler will reside on
 * @param handler: The `RequestHandler` responsible for handling the request
 * @returns A new `Route` handling requests at a path
 */
export let all = (path, handler) => {
  createRoute(path, All, handler)
}

/**
 * Creates a new `Route` composed of multiple sub-routes defined relative to
 * the path given. A middleware is also applied to all requests in the scope.
 * 
 * @param path: The relative path the request handler will reside on
 * @param middleware: The middleware to apply to the routes in the scope
 * @param routes: The `Route`s composing the scope
 * @returns A new `Route` handling requests rooted from the path
 */
export let scopeWithMiddleware = (path, middleware, routes) => {
  { path, routeHandler: Scope(middleware, routes) }
}

/**
 * Creates a new `Route` composed of multiple sub-routes defined relative to the path given.
 * 
 * @param path: The relative path the request handler will reside on
 * @param routes: The `Route`s composing the scope
 * @returns A new `Route` handling requests rooted from the path
 */
export let scope = (path, routes) => {
  scopeWithMiddleware(path, identity, routes)
}

let getWagiEnv = () => {
  let vars = match (Process.env()) {
    Ok(vars) => vars,
    Err(err) =>
      failWithMsgWithErr("Unable to read system environment variables", err),
  }

  Map.fromArray(
    Array.map(var => {
      match (String.indexOf("=", var)) {
        Some(i) => {
          let varName = String.slice(0, i, var)
          let varVal = String.slice(i + 1, String.length(var), var)
          (varName, varVal)
        },
        None => failWithMsg("Error processing environment variable " ++ var),
      }
    }, vars)
  )
}

let getHeaders = wagiEnv => {
  let isHeader = ((key, _)) => String.startsWith("HTTP_", key)
  let headers = List.filter(isHeader, Map.toList(wagiEnv))

  let headerKeyVals = List.map(((key, val)) => {
    let key = String.slice(5, String.length(key), key)
    (key, val)
  }, headers)
  Map.fromList(headerKeyVals)
}

let getBody = wagiEnv => {
  let bodyLengthStr = match (Map.get("CONTENT_LENGTH", wagiEnv)) {
    Some(val) => val,
    None => failWithMsg("Did not find \"CONTENT_LENGTH\" in environment"),
  }

  let bodyLength = match (Number.parseInt(bodyLengthStr, 10)) {
    Ok(num) => num,
    Err(err) =>
      failWithMsgWithErr(
        "Failed to parse \"CONTENT_LENGTH\" from environment to an integer",
        err
      ),
  }

  match (File.fdRead(File.stdin, bodyLength)) {
    Ok((body, _)) => body,
    Err(err) => failWithMsgWithErr("Failed to read request body", err),
  }
}

let getQueryMap = () => {
  match (Process.argv()) {
    Ok(args) => {
      let [_, ...queryParamList] = Array.toList(args)
      urlDecodeParts(queryParamList)
    },
    Err(err) => failWithMsgWithErr("Unable to read system arguments", err),
  }
}

// TODO allow escaping of <
// a bit of a hack to not capture regex groups specified in route.
// if something is going wrong with matching patterns it may be due to this
let captureGroupRegex = Result.unwrap(Regex.make("(?<!\\\\)\\((?!\\?)"))
let replaceWithCapturesRegex = Result.unwrap(
  Regex.make("<\\w+\\(\\?:(.+?)\\)>")
)
let paramRegex = Result.unwrap(Regex.make("<\\w+>"))
let customParamRegex = Result.unwrap(Regex.make("<\\w+\\((.+?)\\)>"))
// lookbehind to prevent single slash character from being matched
let slashAtEndRegex = Result.unwrap(Regex.make("/$"))

// test-export
let preprocessRouteRegex = route => {
  let preprocessed = List.reduce(
    (str, (regex, replaceWith)) => Regex.replaceAll(regex, str, replaceWith),
    route,
    [
      (captureGroupRegex, "(?:"),
      (replaceWithCapturesRegex, "($1)"),
      (customParamRegex, "($1)"),
      (paramRegex, "(\\w+)"),
      (slashAtEndRegex, ""),
    ]
  )
  // should probably replace with regex once
  // https://github.com/grain-lang/grain/issues/1431 is fixed
  (if (!String.startsWith("/", preprocessed)) "/" else "") ++ preprocessed
}

enum RouteMatchStatus {
  NoMatch,
  BaseRouteMatch(Number),
  MethodNotSupported(List<Method>),
  ExactMatch,
}

// use a "precedence" value to keep track of best route found e.g. to
// make a route with wrong method override one not found at all
let bestRouteMatch = (first, second, mnaHandler) => {
  let precedence = rms =>
    match (rms) {
      NoMatch => 1,
      BaseRouteMatch(_) => 2,
      MethodNotSupported(_) => 3,
      ExactMatch => 4,
    }

  let (_, pathParams, firstRms) = first
  let (_, _, secondRms) = second
  match ((firstRms, secondRms)) {
    (MethodNotSupported(firstMethods), MethodNotSupported(secondMethods)) => {
      let methods = List.unique(List.append(firstMethods, secondMethods))
      (req => mnaHandler(methods, req), pathParams, MethodNotSupported(methods))
    },
    (BaseRouteMatch(firstLevel), BaseRouteMatch(secondLevel)) => {
      if (firstLevel > secondLevel) first else second
    },
    _ when precedence(firstRms) > precedence(secondRms) => first,
    _ => second,
  }
}

let paramNameRegex = Result.unwrap(Regex.make("<(\\w+)(?:\\(.+?\\))?>"))

// test-export
let findReqHandler = (reqMethod, reqPath, route, handlers) => {
  let (notFoundHandler, mnaHandler) = handlers

  let reqPath = if (reqPath != "/") Regex.replace(slashAtEndRegex, reqPath, "")
    else "/"

  // performs breadth-first-search to find suitable request
  // handler for the given path and method.
  let rec findReqHandlerHelper = (pathSegment, route, pathVars, level) => {
    let isTerminal = match (route.routeHandler) {
      Endpoint(_, _) => true,
      _ => false,
    }

    let preprocessed = "^" ++
      preprocessRouteRegex(route.path) ++
      (if (isTerminal) "$" else "")

    let routeRegex = match (Regex.make(preprocessed)) {
      Err(_) => failWithMsg("Invalid route regex " ++ route.path),
      Ok(routeRegex) => routeRegex,
    }
    match (Regex.find(routeRegex, pathSegment)) {
      None => (notFoundHandler, pathVars, BaseRouteMatch(level)),
      Some(pathMatch) => {
        let paramNames = List.map((m: Regex.MatchResult) =>
          Option.unwrap(m.group(1)), Regex.findAll(paramNameRegex, route.path))

        // capture groups being matched means we have found path parameter values
        let pathVars = if (pathMatch.numGroups > 1) {
          let paramValsArr = Array.map(Option.unwrap, pathMatch.allGroups())
          let [_, ...paramVals] = Array.toList(paramValsArr)
          let newParams = List.zip(paramNames, paramVals)
          List.append(pathVars, newParams)
        } else {
          pathVars
        }

        let reqHandler = match (route.routeHandler) {
          Endpoint(handlerMethods, reqHandler) => {
            match (handlerMethods) {
              Methods(methods) when !List.contains(reqMethod, methods) =>
                (
                  req =>
                    mnaHandler(methods, req),
                  pathVars,
                  MethodNotSupported(methods),
                ),
              _ => (reqHandler, pathVars, ExactMatch),
            }
          },
          Scope(middleware, routeHandlers) => {
            let (_, thisPathEndI) = Option.unwrap(pathMatch.groupPosition(0))
            let nextPathSegment = String.slice(
              thisPathEndI,
              String.length(pathSegment),
              pathSegment
            )
            let nextPathSegment = if (!String.startsWith("/", nextPathSegment))
                "/" ++
                nextPathSegment else nextPathSegment
            let (bestReqHandler, bestPathParams, bestRms) = List.reduce(
              (best, routeHandler) => {
                let this = findReqHandlerHelper(
                  nextPathSegment,
                  routeHandler,
                  pathVars,
                  level + 1
                )
                // overwrite matched route handler if it is better than
                // the best one found so far
                bestRouteMatch(best, this, mnaHandler)
              },
              (notFoundHandler, pathVars, NoMatch),
              routeHandlers
            )
            (middleware(bestReqHandler), bestPathParams, bestRms)
          },
        }
        reqHandler
      },
    }
  }
  let (reqHandler, pathParams, _) = findReqHandlerHelper(reqPath, route, [], 0)
  (reqHandler, Map.fromList(pathParams))
}

let getOptions = optionsList => {
  let defaultNFH = req => {
    response(
      NotFound,
      Map.fromList([("Content-Type", "text/plain")]),
      "Requested URL not found"
    )
  }

  let defaultMNAH = (allowed, req) => {
    let allow = List.join(", ", List.map(methodToString, allowed))
    response(
      MethodNotAllowed,
      Map.fromList([("Content-Type", "text/plain"), ("Allow", allow)]),
      "Method not allowed for this URL"
    )
  }

  let (nfh, mnah) = List.reduce(((nfh, mnah), this) => match (this) {
    NotFoundHandler(x) => (Option.or(nfh, Some(x)), mnah),
    MethodNotAllowedHandler(x) => (nfh, Option.or(mnah, Some(x))),
  }, (None, None), optionsList) 

  let nfh = Option.unwrapWithDefault(defaultNFH, nfh)
  let mnah = Option.unwrapWithDefault(defaultMNAH, mnah)
  (nfh, mnah)
}

let outputResponse = (res: Response) => {
  let headers = headers(res)
  // script must specify Content-Type per CGI v1.1 spec, so default to
  // application/octet-stream if one was not given
  Map.update(
    "content-type",
    val => match (val) {
      None => Some("application/octet-stream"),
      _ => val,
    },
    headers
  )
  Map.set("status", toString(statusToCode(status(res))), headers)

  let headers = List.sort(compare, Map.toList(headers))
  let safeHeaders = List.map(((key, val)) => {
    // remove any newline characters from headers because that will cause
    // header values to be written to body (since a blank line separates
    // headers from body in CGI spec)
    let makeSafe = str =>
      String.implode(Array.filter(c => c != '\n', String.explode(str)))
    (makeSafe(key), makeSafe(val))
  }, headers)

  List.forEach(((key, val)) => print(key ++ ": " ++ val), safeHeaders)
  // empty line separates headers from body per CGI spec
  print("")
  print(body(res))
}

/**
 * @section Serving: Functions for declaring servers, the starting points of Hopper applications.
 */

/**
 * Entry point for creating a server, taking a list of routes and options to
 * apply for the server.
 * 
 * @param middleware: The middleware to apply to all routes in the application
 * @param options: The options to use for the server
 * @param routes: The root routes for the server
 */
export let serveWithMiddlewareAndOptions = (middleware, options, routes) => {
  let wagiEnv = getWagiEnv()

  let rootRoute = scopeWithMiddleware("/", middleware, routes)
  let (reqHandler, params) = findReqHandler(
    getReqMethod(wagiEnv),
    getPath(wagiEnv),
    rootRoute,
    getOptions(options)
  )

  let request = {
    _message: { _wagiEnv: wagiEnv, _params: params, _query: getQueryMap() },
    _variables: Map.make(),
    _headers: getHeaders(wagiEnv),
    _body: getBody(wagiEnv),
  }
  let response = reqHandler(request)
  outputResponse(response)
}

/**
 * Entry point for creating a server, taking a list of route handlers and using
 * a default set of options.
 * 
 * @param middleware: The middleware to apply to all routes in the application
 * @param routes: The root routes for the server
 */
export let serveWithMiddleware = (middleware, routes) => {
  serveWithMiddlewareAndOptions(middleware, [], routes)
}

/**
 * Entry point for creating a server, taking a list of route handlers and using
 * a default set of options.
 * 
 * @param options: The options to use for the server
 * @param routes: The root routes for the server
 */
export let serveWithOptions = (options, routes) => {
  serveWithMiddlewareAndOptions(identity, options, routes)
}

/**
 * Entry point for creating a server, taking a list of route handlers and using
 * a default set of options.
 * 
 * @param routes: The root routes for the server
 */
export let serve = routes => {
  serveWithMiddlewareAndOptions(identity, [], routes)
}