Top.postFields

11 files changed, 83 insertions, 3 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index 9e73e5ae..c7a6491b 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2310,7 +2310,7 @@ A web application is built from a series of modules, with one module, the last o
 
 Elements of modules beside the main module, including page handlers, will only be included in the final application if they are transitive dependencies of the handlers in the main module.
 
-Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects.  To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$.  When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$).  This kind of handler will only work with \texttt{POST} payloads of MIME types besides those associated with HTML forms; for these, use Ur/Web's built-in support, as described below.
+Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects.  To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$.  When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$).  This kind of handler should not be used with forms that exist solely within Ur/Web apps; for these, use Ur/Web's built-in support, as described below.  It may still be useful to use $\mt{Basis.postBody}$ with form requests submitted by code outside an Ur/Web app.  For such cases, the function $\mt{Top.postFields} : \mt{postBody} \to \mt{list} \; (\mt{string} \times \mt{string})$ may be useful, breaking a \texttt{POST} body of type \texttt{application/x-www-form-urlencoded} into its name-value pairs.
 
 Any normal page handler may also include arguments of type $\mt{option \; Basis.queryString}$, which will be handled specially.  Rather than being deserialized from the current URI, such an argument is passed the whole query string that the handler received.  The string may be analyzed by calling $\mt{Basis.show}$ on it.  A handler of this kind may be passed as an argument to $\mt{Basis.effectfulUrl}$ to generate a URL to a page that may be used as a ``callback'' by an external service, such that the handler is allowed to cause side effects.
 
diff --git a/include/urweb/types.h b/include/urweb/types.h
index c401b38f..152f4392 100644
--- a/include/urweb/types.h
+++ b/include/urweb/types.h
@@ -51,6 +51,10 @@ typedef struct uw_Basis_postBody {
 
 typedef uw_Basis_string uw_Basis_queryString;
 
+typedef struct {
+  uw_Basis_string name, value, remaining;
+} uw_Basis_postField;
+
 typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY, RETURN_INDIRECTLY } failure_kind;
 
 typedef enum { SERVED, KEEP_OPEN, FAILED } request_result;
diff --git a/include/urweb/urweb.h b/include/urweb/urweb.h
index 21c8bc88..af0aafdb 100644
--- a/include/urweb/urweb.h
+++ b/include/urweb/urweb.h
@@ -363,4 +363,9 @@ uw_Basis_string uw_Basis_property(uw_context, uw_Basis_string);
 void uw_begin_initializing(uw_context);
 void uw_end_initializing(uw_context);
 
+uw_Basis_string uw_Basis_fieldName(uw_context, uw_Basis_postField);
+uw_Basis_string uw_Basis_fieldValue(uw_context, uw_Basis_postField);
+uw_Basis_string uw_Basis_remainingFields(uw_context, uw_Basis_postField);
+uw_Basis_postField *uw_Basis_firstFormField(uw_context, uw_Basis_string);
+
 #endif
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 8ac94668..cb5d16ea 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -898,6 +898,12 @@ type postBody
 val postType : postBody -> string
 val postData : postBody -> string
 
+type postField
+val firstFormField : string -> option postField
+val fieldName : postField -> string
+val fieldValue : postField -> string
+val remainingFields : postField -> string
+
 con radio = [Body, Radio]
 val radio : formTag (option string) radio [Id = id]
 val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] []
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index e504204e..5b9d43ab 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -393,3 +393,15 @@ fun mkRead' [t ::: Type] (f : string -> option t) (name : string) : read t =
     mkRead (fn s => case f s of
                         None => error <xml>Invalid {txt name}: {txt s}</xml>
                       | Some v => v) f
+
+fun postFields pb =
+    let
+        fun postFields' s =
+            case firstFormField s of
+                None => []
+              | Some f => (fieldName f, fieldValue f) :: postFields' (remainingFields f)
+    in
+        case postType pb of
+            "application/x-www-form-urlencoded" => postFields' (postData pb)
+          | _ => error <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
+    end
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 489e744d..30f1eaad 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -281,3 +281,5 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
                   -> sql_exp tables agg exps bool
 
 val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
+
+val postFields : postBody -> list (string * string)
diff --git a/src/c/request.c b/src/c/request.c
index a697ba44..b23c251f 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -294,7 +294,7 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
       boundary[0] = '-';
       boundary[1] = '-';
       boundary_len = strlen(boundary);
-    } else if (clen_s && strcasecmp(clen_s, "application/x-www-form-urlencoded")) {
+    } else if (clen_s) {
       uw_Basis_postBody pb = {clen_s, body};
       uw_postBody(ctx, pb);
     }
diff --git a/src/c/urweb.c b/src/c/urweb.c
index d0b6987c..0ccc418a 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4086,3 +4086,43 @@ uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) {
 
   return s;
 }
+
+uw_Basis_string uw_Basis_fieldName(uw_context ctx, uw_Basis_postField f) {
+  return f.name;
+}
+
+uw_Basis_string uw_Basis_fieldValue(uw_context ctx, uw_Basis_postField f) {
+  return f.value;
+}
+
+uw_Basis_string uw_Basis_remainingFields(uw_context ctx, uw_Basis_postField f) {
+  return f.remaining;
+}
+
+uw_Basis_postField *uw_Basis_firstFormField(uw_context ctx, uw_Basis_string s) {
+  char *amp, *eq, *unurl, *copy;
+  uw_Basis_postField *f;
+
+  if (s[0] == 0)
+    return NULL;
+
+  amp = strchr(s, '&');
+  copy = uw_malloc(ctx, amp ? amp - s + 1 : strlen(s) + 1);
+  if (amp) {
+    strncpy(copy, s, amp - s);
+    copy[amp - s] = 0;
+  } else
+    strcpy(copy, s);
+
+  eq = strchr(copy, '=');
+  if (eq)
+    *eq++ = 0;
+
+  f = uw_malloc(ctx, sizeof(uw_Basis_postField));
+  unurl = copy;
+  f->name = uw_Basis_unurlifyString(ctx, &unurl);
+  f->value = eq ? (unurl = eq, uw_Basis_unurlifyString(ctx, &unurl)) : "";
+  f->remaining = amp ? amp+1 : "";
+
+  return f;
+}
diff --git a/src/settings.sml b/src/settings.sml
index dcaf392d..9359337d 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -218,7 +218,11 @@ val serverBase = basis ["requestHeader",
                         "nextval",
                         "setval",
                         "channel",
-                        "send"]
+                        "send",
+                        "fieldName",
+                        "fieldValue",
+                        "remainingFields",
+                        "firstFormField"]
 val server = ref serverBase
 fun setServerOnly ls = server := S.addList (serverBase, ls)
 fun isServerOnly x = S.member (!server, x)
diff --git a/tests/formFields.ur b/tests/formFields.ur
new file mode 100644
index 00000000..2dbf2d53
--- /dev/null
+++ b/tests/formFields.ur
@@ -0,0 +1,3 @@
+fun main (pb : postBody) : transaction page = return <xml><body>
+  {List.mapX (fn (n, v) => <xml><li>{[n]} = {[v]}</li></xml>) (postFields pb)}
+</body></xml>
diff --git a/tests/formFields.urp b/tests/formFields.urp
new file mode 100644
index 00000000..82f95f1c
--- /dev/null
+++ b/tests/formFields.urp
@@ -0,0 +1,4 @@
+rewrite url FormFields/*
+
+$/list
+formFields