From 8bdd29f65c57570776f0c9f90d75f7818b0cdaa6 Mon Sep 17 00:00:00 2001 From: steinuil Date: Sat, 4 Aug 2018 18:04:32 +0200 Subject: removed invalid JSON escape character --- lib/ur/json.ur | 2 -- 1 file changed, 2 deletions(-) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 817ec16e..589e81b0 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -51,7 +51,6 @@ fun escape s = | #"\r" => "\\r" | #"\t" => "\\t" | #"\"" => "\\\"" - | #"\'" => "\\\'" | #"\\" => "\\\\" | #"/" => "\\/" | x => String.str ch @@ -101,7 +100,6 @@ fun unescape s = | #"r" => "\r" | #"t" => "\t" | #"\"" => "\"" - | #"\'" => "\'" | #"\\" => "\\" | #"/" => "/" | x => error JSON unescape: Bad escape char: {[x]}) -- cgit v1.2.3 From d51f7f2770858713204b7e670119090a26c9f194 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 27 Mar 2019 23:20:29 -0400 Subject: Don't escape slashes for JSON --- lib/ur/json.ur | 1 - 1 file changed, 1 deletion(-) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 589e81b0..05406739 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -52,7 +52,6 @@ fun escape s = | #"\t" => "\\t" | #"\"" => "\\\"" | #"\\" => "\\\\" - | #"/" => "\\/" | x => String.str ch ) ^ esc (String.suffix s 1) end -- cgit v1.2.3 From 8728f397bee2b567611dcd7a7c359c7e92159c1c Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 25 Sep 2019 19:54:59 -0400 Subject: Unicode escapes in JSON --- include/urweb/urweb_cpp.h | 1 + lib/ur/basis.urs | 1 + lib/ur/json.ur | 29 +++++++++++++++++++++++++++++ src/c/urweb.c | 12 ++++++++++++ 4 files changed, 43 insertions(+) (limited to 'lib/ur/json.ur') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index dcf67fef..e4ad6e61 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -166,6 +166,7 @@ uw_Basis_string uw_Basis_strchr(struct uw_context *, const char *, uw_Basis_char uw_Basis_int uw_Basis_strcspn(struct uw_context *, const char *, const char *); uw_Basis_string uw_Basis_substring(struct uw_context *, const char *, uw_Basis_int, uw_Basis_int); uw_Basis_string uw_Basis_str1(struct uw_context *, uw_Basis_char); +uw_Basis_string uw_Basis_ofUnicode(struct uw_context *, uw_Basis_int); uw_Basis_string uw_strdup(struct uw_context *, const char *); uw_Basis_string uw_maybe_strdup(struct uw_context *, const char *); diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 2a98bf6f..d29bf6e6 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -95,6 +95,7 @@ val strsindex : string -> string -> option int val strcspn : string -> string -> int val substring : string -> int -> int -> string val str1 : char -> string +val ofUnicode : int -> string class show val show : t ::: Type -> show t -> t -> string diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 05406739..70f0c797 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -59,6 +59,17 @@ fun escape s = "\"" ^ esc s end +fun unhex ch = + if Char.isDigit ch then + Char.toInt ch - Char.toInt #"0" + else if Char.isXdigit ch then + if Char.isUpper ch then + 10 + (Char.toInt ch - Char.toInt #"A") + else + 10 + (Char.toInt ch - Char.toInt #"a") + else + error Invalid hexadecimal digit "{[ch]}" + fun unescape s = let val len = String.length s @@ -75,6 +86,11 @@ fun unescape s = | #"\\" => if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} + else if String.sub s (i + 1) = #"u" then + if i+5 >= len then + error JSON unescape: Bad escape sequence: {[s]} + else + findEnd (i+6) else findEnd (i+2) | _ => findEnd (i+1) @@ -93,6 +109,19 @@ fun unescape s = #"\\" => if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} + else if String.sub s (i+1) = #"u" then + if i+5 >= len then + error JSON unescape: Unicode ends early + else + let + val n = + unhex (String.sub s (i+2)) * (256*16) + + unhex (String.sub s (i+3)) * 256 + + unhex (String.sub s (i+4)) * 16 + + unhex (String.sub s (i+5)) + in + ofUnicode n ^ unesc (i+6) + end else (case String.sub s (i+1) of #"n" => "\n" diff --git a/src/c/urweb.c b/src/c/urweb.c index af929269..8c445f39 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -2724,6 +2724,18 @@ uw_Basis_string uw_Basis_str1(uw_context ctx, uw_Basis_char ch) { return r; } +uw_Basis_string uw_Basis_ofUnicode(uw_context ctx, uw_Basis_int n) { + UChar buf16[] = {n}; + uw_Basis_string out = uw_malloc(ctx, 3); + int32_t outLen; + UErrorCode pErrorCode = 0; + + if (u_strToUTF8(out, 3, &outLen, buf16, 1, &pErrorCode) == NULL || outLen == 0) + uw_error(ctx, FATAL, "Bad Unicode string to unescape (error %s)", u_errorName(pErrorCode)); + + return out; +} + uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) { int len = strlen(s1) + 1; char *s; -- cgit v1.2.3 From 39bfe4b44542852a656a3793d1f245bf31503b49 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 5 Oct 2019 10:34:33 -0400 Subject: Optimize JSON unescaping for server-side execution --- lib/ur/json.ur | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 70f0c797..e2bdd4df 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -74,56 +74,56 @@ fun unescape s = let val len = String.length s - fun findEnd i = + fun findEnd i s = if i >= len then error JSON unescape: string ends before quote: {[s]} else let - val ch = String.sub s i + val ch = String.sub s 0 in case ch of #"\"" => i | #"\\" => if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} - else if String.sub s (i + 1) = #"u" then + else if String.sub s 1 = #"u" then if i+5 >= len then error JSON unescape: Bad escape sequence: {[s]} else - findEnd (i+6) + findEnd (i+6) (String.suffix s 6) else - findEnd (i+2) - | _ => findEnd (i+1) + findEnd (i+2) (String.suffix s 2) + | _ => findEnd (i+1) (String.suffix s 1) end - val last = findEnd 1 + val last = findEnd 1 (String.suffix s 1) - fun unesc i = + fun unesc i s = if i >= last then "" else let - val ch = String.sub s i + val ch = String.sub s 0 in case ch of #"\\" => if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} - else if String.sub s (i+1) = #"u" then + else if String.sub s 1 = #"u" then if i+5 >= len then error JSON unescape: Unicode ends early else let val n = - unhex (String.sub s (i+2)) * (256*16) - + unhex (String.sub s (i+3)) * 256 - + unhex (String.sub s (i+4)) * 16 - + unhex (String.sub s (i+5)) + unhex (String.sub s 2) * (256*16) + + unhex (String.sub s 3) * 256 + + unhex (String.sub s 4) * 16 + + unhex (String.sub s 5) in - ofUnicode n ^ unesc (i+6) + ofUnicode n ^ unesc (i+6) (String.suffix s 6) end else - (case String.sub s (i+1) of + (case String.sub s 1 of #"n" => "\n" | #"r" => "\r" | #"t" => "\t" @@ -132,14 +132,14 @@ fun unescape s = | #"/" => "/" | x => error JSON unescape: Bad escape char: {[x]}) ^ - unesc (i+2) - | _ => String.str ch ^ unesc (i+1) + unesc (i+2) (String.suffix s 2) + | _ => String.str ch ^ unesc (i+1) (String.suffix s 1) end in if len = 0 || String.sub s 0 <> #"\"" then error JSON unescape: String doesn't start with double quote: {[s]} else - (unesc 1, String.substring s {Start = last+1, Len = len-last-1}) + (unesc 1 (String.suffix s 1), String.suffix s (last+1)) end val json_string = {ToJson = escape, -- cgit v1.2.3 From f7b684dbdae9229a69258a7e575395af120d2654 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 11 Oct 2019 15:06:18 -0400 Subject: JSON records with optional fields --- lib/ur/json.ur | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/ur/json.urs | 4 +++ 2 files changed, 89 insertions(+) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index e2bdd4df..0865ab33 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -287,6 +287,91 @@ fun skipOne s = skipOne s False False 0 0 end +fun json_record_withOptional [ts ::: {Type}] [ots ::: {Type}] [ts ~ ots] + (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) + (ofl : folder ots) (ojss : $(map json ots)) (onames : $(map (fn _ => string) ots)): json $(ts ++ map option ots) = + {ToJson = fn r => + let + val withRequired = + @foldR3 [json] [fn _ => string] [ident] [fn _ => string] + (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc => + escape name ^ ":" ^ j.ToJson v ^ (case acc of + "" => "" + | acc => "," ^ acc)) + "" fl jss names (r --- _) + + val withOptional = + @foldR3 [json] [fn _ => string] [option] [fn _ => string] + (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc => + case v of + None => acc + | Some v => + escape name ^ ":" ^ j.ToJson v ^ (case acc of + "" => "" + | acc => "," ^ acc)) + "" ofl ojss onames (r --- _) + in + "{" ^ withOptional ^ "}" + end, + FromJson = fn s => + let + fun fromJ s (r : $(map option (ts ++ ots))) : $(map option (ts ++ ots)) * string = + if String.length s = 0 then + error JSON object doesn't end in brace + else if String.sub s 0 = #"}" then + (r, String.substring s {Start = 1, Len = String.length s - 1}) + else let + val (name, s') = unescape s + val s' = skipSpaces s' + val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then + error No colon after JSON object field name + else + skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) + + val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string] + (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r => + if name = name' then + let + val (v, s') = j.FromJson s' + in + (r -- nm ++ {nm = Some v}, s') + end + else + let + val (r', s') = acc (r -- nm) + in + (r' ++ {nm = r.nm}, s') + end) + (fn r => (r, skipOne s')) + (@Folder.concat ! fl ofl) (jss ++ ojss) (names ++ onames) r + + val s' = skipSpaces s' + val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then + skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) + else + s' + in + fromJ s' r + end + in + if String.length s = 0 || String.sub s 0 <> #"{" then + error JSON record doesn't begin with brace + else + let + val (r, s') = fromJ (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1})) + (@map0 [option] (fn [t ::_] => None) (@Folder.concat ! fl ofl)) + in + (@map2 [option] [fn _ => string] [ident] (fn [t] (v : option t) name => + case v of + None => error Missing JSON object field {[name]} + | Some v => v) fl (r --- _) names + ++ (r --- _), s') + end +end} + +(* At the moment, the below code is largely copied and pasted from the last + * definition, because otherwise the compiler fails to inline enough for + * compilation to succeed. *) fun json_record [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json $ts = {ToJson = fn r => "{" ^ @foldR3 [json] [fn _ => string] [ident] [fn _ => string] (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc => diff --git a/lib/ur/json.urs b/lib/ur/json.urs index b4bd6350..56f5a897 100644 --- a/lib/ur/json.urs +++ b/lib/ur/json.urs @@ -17,6 +17,10 @@ val json_option : a ::: Type -> json a -> json (option a) val json_list : a ::: Type -> json a -> json (list a) val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts +val json_record_withOptional : ts ::: {Type} -> ots ::: {Type} -> [ts ~ ots] + => folder ts -> $(map json ts) -> $(map (fn _ => string) ts) + -> folder ots -> $(map json ots) -> $(map (fn _ => string) ots) + -> json $(ts ++ map option ots) val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts) val json_unit : json unit -- cgit v1.2.3 From b71c7b9ec4580326772a212fbe011322ae1ac063 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 11 Oct 2019 17:18:02 -0400 Subject: JSON instance for times, based on RFC 3339 (because Google APIs use it) --- lib/ur/json.ur | 47 +++++++++++++++++++++++++++++++++++++++++++++++ lib/ur/json.urs | 1 + 2 files changed, 48 insertions(+) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 0865ab33..58822d4b 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -145,6 +145,53 @@ fun unescape s = val json_string = {ToJson = escape, FromJson = unescape} +fun rfc3339_out s = + let + val out1 = timef "%Y-%m-%dT%H:%M:%S%z" s + val len = String.length out1 + in + if len < 2 then + error timef output too short + else + String.substring out1 {Start = 0, Len = len - 2} ^ ":" + ^ String.suffix out1 (len - 2) + end + +fun rfc3339_in s = + case String.split s #"T" of + None => error Invalid RFC 3339 string "{[s]}" + | Some (date, time) => + case String.msplit {Haystack = time, Needle = "Z+-"} of + None => error Invalid RFC 3339 string "{[s]}" + | Some (time, sep, rest) => + let + val t = case readUtc (date ^ " " ^ time) of + None => error Invalid RFC 3339 string "{[s]}" + | Some t => t + + fun withOffset multiplier = + case String.split rest #":" of + None => error Invalid RFC 3339 string "{[s]}" + | Some (h, m) => + case (read h, read m) of + (Some h, Some m) => addSeconds t (multiplier * 60 * (60 * h + m)) + | _ => error Invalid RFC 3339 string "{[s]}" + in + case sep of + #"Z" => t + | #"+" => withOffset (-1) + | #"-" => withOffset 1 + | _ => error msplit returns impossible separator + end + +val json_time = {ToJson = fn tm => escape (rfc3339_out tm), + FromJson = fn s => + let + val (v, s') = unescape s + in + (rfc3339_in v, s') + end} + fun numIn [a] (_ : read a) s : a * string = let val len = String.length s diff --git a/lib/ur/json.urs b/lib/ur/json.urs index 56f5a897..7b83d03d 100644 --- a/lib/ur/json.urs +++ b/lib/ur/json.urs @@ -13,6 +13,7 @@ val json_string : json string val json_int : json int val json_float : json float val json_bool : json bool +val json_time : json time val json_option : a ::: Type -> json a -> json (option a) val json_list : a ::: Type -> json a -> json (list a) -- cgit v1.2.3 From 383e3a559b65432e9e2357dc35670ce147be96da Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 19 Dec 2019 11:58:13 -0500 Subject: Fix toJson for records with optional fields --- lib/ur/json.ur | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 58822d4b..eed52fd6 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -356,7 +356,7 @@ fun json_record_withOptional [ts ::: {Type}] [ots ::: {Type}] [ts ~ ots] escape name ^ ":" ^ j.ToJson v ^ (case acc of "" => "" | acc => "," ^ acc)) - "" ofl ojss onames (r --- _) + withRequired ofl ojss onames (r --- _) in "{" ^ withOptional ^ "}" end, -- cgit v1.2.3 From 7dc460aece761171338fe61f1a6d601e3d0b6e62 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Mon, 23 Dec 2019 16:52:46 -0500 Subject: More lenient RFC 3339 parsing --- lib/ur/json.ur | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lib/ur/json.ur') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index eed52fd6..1222cdbf 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -165,6 +165,10 @@ fun rfc3339_in s = None => error Invalid RFC 3339 string "{[s]}" | Some (time, sep, rest) => let + val time = case String.split time #"." of + None => time + | Some (time, _) => time + val t = case readUtc (date ^ " " ^ time) of None => error Invalid RFC 3339 string "{[s]}" | Some t => t -- cgit v1.2.3