diff --git a/example/README.md b/example/README.md
index 0112b83..f4d4e09 100644
--- a/example/README.md
+++ b/example/README.md
@@ -29,8 +29,10 @@ list below and jump to whatever interests you!
- [**`b-session`**](b-session/#files) — associates state with
client sessions.
- [**`c-cookie`**](c-cookie/#files) — sets custom cookies.
-- [**`d-form`**](d-form) — reading forms and CSRF prevention.
-- [**`e-json`**](e-json)
+- [**`d-form`**](d-form#files) — reading forms and CSRF
+ prevention.
+- [**`e-json`**](e-json#files) — sending and receiving JSON
+ securely.
- [**`f-static`**](f-static)
- [**`g-upload`**](g-upload)
- [**`h-sql`**](h-sql) — finally CRUD!
diff --git a/example/e-json/README.md b/example/e-json/README.md
index 300f506..dc5a78c 100644
--- a/example/e-json/README.md
+++ b/example/e-json/README.md
@@ -2,62 +2,108 @@
-TODO
+
-
-
-
+JSON handling is a bit awkward in OCaml at the present time, and Dream will look
+into improving it in its first few releases. The example below shows manual
+JSON handling with [Yojson](https://github.com/ocaml-community/yojson#readme).
+It can also be greatly simplified with
+[ppx_yojson_conv](https://github.com/janestreet/ppx_yojson_conv#readme).
```ocaml
-let show_form ?message request =
-
-
-% begin match message with
-% | None -> ()
-% | Some message ->
-
You entered: <%s message %>!
-% end;
- <%s! Dream.Tag.form ~action:"/" request %>
-
-
-
-
+let to_json request =
+
+ match Dream.header "Content-Type" request with
+ | Some "application/json" ->
+
+ let%lwt body = Dream.body request in
+
+ begin match Yojson.Basic.from_string body with
+ | exception _ -> Lwt.return None
+ | json -> Lwt.return (Some json)
+ end
+
+ | _ -> Lwt.return None
let () =
Dream.run
@@ Dream.logger
- @@ Dream.sessions_in_memory
+ @@ Dream.origin_referer_check
@@ Dream.router [
- Dream.get "/"
- (fun request ->
- Dream.respond (show_form request));
-
Dream.post "/"
(fun request ->
- match%lwt Dream.form request with
- | `Ok ["message", message] ->
- Dream.respond (show_form ~message request)
- | _ ->
- Dream.empty `Bad_Request);
+ match%lwt to_json request with
+ | None -> Dream.empty `Bad_Request
+ | Some json ->
+
+ let maybe_message =
+ Yojson.Basic.Util.(member "message" json |> to_string_option) in
+ match maybe_message with
+ | None -> Dream.empty `Bad_Request
+ | Some message ->
+
+ `String message
+ |> Yojson.Basic.to_string
+ |> Dream.respond ~headers:["Content-Type", "application/json"]);
]
@@ Dream.not_found
```
-
$ dune exec --root . ./promise.exe
+
$ dune exec --root . ./json.exe
-TODO
+This example expects JSON of the form `{"message": "some-message"}`, and echoes
+the message as a JSON string. Let's test it immediately with both curl and
+[HTTPie](https://httpie.io/):
+
+
+
+
+## Security
+
+[`Dream.origin_referer_check`](https://aantron.github.io/dream/#val-origin_referer_check)
+implements the
+[OWASP Verifying Origin With Standard Headers](https://cheatsheetseries.owasp.org/cheatsheets/Cross-Site_Request_Forgery_Prevention_Cheat_Sheet.html#verifying-origin-with-standard-headers)
+CSRF protection technique. It doesn't protect `GET` requests, so they shouldn't
+do mutations. It also isn't good enough for cross-origin usage in its current
+form. But it is enough to do AJAX in small and medium web apps without the need
+for [generating tokens](https://aantron.github.io/dream/#csrf-tokens).
+
+This technique relies on that the browser will send matching `Origin:` (or
+`Referer:`) and `Host:` headers to the Web app for a genuine request, while,
+for a cross-site request, `Origin:` and `Host:` will not match —
+`Origin:` will be the other site or `null`. Try varying the headers in the
+`curl` and `http` commands to see the check in action, rejecting your nefarious
+requests!
+
+
**Next steps:**
-- [**`b-session`**](../b-session/#files) introduces *session management* for
- associating state with clients.
-- [**`c-cookie`**](../c-cookie/#files) shows *cookie handling* in Dream.
+- [**`f-static`**](../f-static#files) serves static files from the local
+ file system.
+- [**`g-upload`**](../g-upload#files) receives files from an upload form.
diff --git a/example/e-json/dune b/example/e-json/dune
index a38d86f..04fa891 100644
--- a/example/e-json/dune
+++ b/example/e-json/dune
@@ -2,8 +2,3 @@
(name json)
(libraries dream)
(preprocess (pps lwt_ppx)))
-
-(rule
- (targets json.ml)
- (deps json.eml.ml)
- (action (run dream_eml %{deps} --workspace %{workspace_root})))
diff --git a/example/e-json/json.eml.ml b/example/e-json/json.eml.ml
deleted file mode 100644
index d489159..0000000
--- a/example/e-json/json.eml.ml
+++ /dev/null
@@ -1,34 +0,0 @@
-let home =
-
-
-
-
-
-
-
-let count = ref 0
-
-let () =
- Dream.run
- @@ Dream.logger
- @@ Dream.router [
-
- Dream.get "/"
- (fun _ ->
- Dream.respond home);
-
- Dream.post "/ajax" @@ Dream.origin_referer_check @@
- (fun _ ->
- incr count;
- Dream.respond ~headers:["Content-Type", "application/json"]
- (Printf.sprintf "{\"count\": %i}" !count));
-
- ]
- @@ Dream.not_found
diff --git a/example/e-json/json.ml b/example/e-json/json.ml
new file mode 100644
index 0000000..bc71718
--- /dev/null
+++ b/example/e-json/json.ml
@@ -0,0 +1,38 @@
+let to_json request =
+
+ match Dream.header "Content-Type" request with
+ | Some "application/json" ->
+
+ let%lwt body = Dream.body request in
+
+ begin match Yojson.Basic.from_string body with
+ | exception _ -> Lwt.return None
+ | json -> Lwt.return (Some json)
+ end
+
+ | _ -> Lwt.return None
+
+let () =
+ Dream.run
+ @@ Dream.logger
+ @@ Dream.origin_referer_check
+ @@ Dream.router [
+
+ Dream.post "/"
+ (fun request ->
+ match%lwt to_json request with
+ | None -> Dream.empty `Bad_Request
+ | Some json ->
+
+ let maybe_message =
+ Yojson.Basic.Util.(member "message" json |> to_string_option) in
+ match maybe_message with
+ | None -> Dream.empty `Bad_Request
+ | Some message ->
+
+ `String message
+ |> Yojson.Basic.to_string
+ |> Dream.respond ~headers:["Content-Type", "application/json"]);
+
+ ]
+ @@ Dream.not_found
diff --git a/src/dream.mli b/src/dream.mli
index 11fbce7..a426c16 100644
--- a/src/dream.mli
+++ b/src/dream.mli
@@ -692,7 +692,11 @@ val write_bigstring : bigstring -> int -> int -> response -> unit promise
Dream presently recommends using
{{:https://github.com/ocaml-community/yojson#readme} Yojson}. See also
{{:https://github.com/janestreet/ppx_yojson_conv#readme} ppx_yojson_conv}
- for generating JSON parsers and serializers for OCaml data types. *)
+ for generating JSON parsers and serializers for OCaml data types.
+
+ See example
+ {{:https://github.com/aantron/dream/tree/master/example/e-json#files}
+ [e-json]}. *)
val origin_referer_check : middleware
(** CSRF protection for AJAX requests. Either the method must be [`GET] or
@@ -701,7 +705,9 @@ val origin_referer_check : middleware
- [Origin:] or [Referer:] must be present, and
- their value must match [Host:]
- Responds with [400 Bad Request] if the check fails.
+ Responds with [400 Bad Request] if the check fails. See example
+ {{:https://github.com/aantron/dream/tree/master/example/e-json#files}
+ [e-json]}.
Implements the
{{:https://cheatsheetseries.owasp.org/cheatsheets/Cross-Site_Request_Forgery_Prevention_Cheat_Sheet.html#verifying-origin-with-standard-headers}
diff --git a/src/middleware/origin_referer_check.ml b/src/middleware/origin_referer_check.ml
index cedc841..71adab3 100644
--- a/src/middleware/origin_referer_check.ml
+++ b/src/middleware/origin_referer_check.ml
@@ -53,7 +53,7 @@ let origin_referer_check inner_handler request =
let host_host, host_port =
match String.split_on_char ':' host with
| [host; port] -> Some host, Some port
- | _ -> None, None
+ | _ -> Some host, None
in
let origin_port =