diff options
| -rw-r--r-- | lib/ur/basis.urs | 1 | ||||
| -rw-r--r-- | src/monoize.sml | 4 | ||||
| -rw-r--r-- | tests/sqlurl.ur | 4 | ||||
| -rw-r--r-- | tests/sqlurl.urp | 6 |
4 files changed, 15 insertions, 0 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 5e5e81c3..ce8ed91f 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -703,6 +703,7 @@ type css_value val atom : string -> css_value type url val css_url : url -> css_value +val sql_url : sql_injectable_prim url type css_property val property : string -> css_property val value : css_property -> css_value -> css_property diff --git a/src/monoize.sml b/src/monoize.sml index 8c33e60b..a639f4a6 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2208,6 +2208,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc), (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc), fm) + | L.EFfi ("Basis", "sql_url") => + ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc), + (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc), + fm) | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) => let val t = monoType env t diff --git a/tests/sqlurl.ur b/tests/sqlurl.ur new file mode 100644 index 00000000..cdd51ca8 --- /dev/null +++ b/tests/sqlurl.ur @@ -0,0 +1,4 @@ +table t : { Url : url } + +task initialize = fn () => + dml (INSERT INTO t (Url) VALUES ({[bless "http://www.google.com/"]})) diff --git a/tests/sqlurl.urp b/tests/sqlurl.urp new file mode 100644 index 00000000..bb5544df --- /dev/null +++ b/tests/sqlurl.urp @@ -0,0 +1,6 @@ +database dbname=test +sql sqlurl.sql +rewrite url Sqlurl/* +allow url http://www.google.com/ + +sqlurl |