1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
open Lwt.Syntax
open Sexplib.Std
let log_src = Logs.Src.create "sihl.middleware.formparser"
module Logs = (val Logs.src_log log_src : Logs.LOG)
type body = (string * string list) list [@@deriving sexp, show]
let pp = pp_body
exception Parsed_body_not_found
let key : body Opium.Context.key =
Opium.Context.Key.create ("form", sexp_of_body)
;;
let find_all req =
match Opium.Context.find key req.Opium.Request.env with
| Some all -> all
| None ->
Logs.err (fun m -> m "Could not find parsed body");
Logs.info (fun m -> m "Have you applied the body parser middleware?");
raise Parsed_body_not_found
;;
let find key req =
let result =
List.find_opt (fun (k, _) -> String.equal k key) (find_all req)
|> Option.map snd
in
let result =
try Some (Option.map List.hd result) with
| _ -> None
in
Option.join result
;;
(** [consume req key] returns the value of the parsed body for the key [key] and
a request with an updated context where the parsed value is missing the key
[key]. The value is returned and removed from the context, it is consumed. **)
let consume req k =
let urlencoded = find_all req in
let value = find k req in
let updated =
List.filter (fun (k_, _) -> not (String.equal k_ k)) urlencoded
in
let env = req.Opium.Request.env in
let env = Opium.Context.add key updated env in
let req = { req with env } in
req, value
;;
let middleware =
let filter handler req =
match req.Opium.Request.meth with
| `POST ->
let content_type =
try
req
|> Opium.Request.header "Content-Type"
|> Option.map (String.split_on_char ';')
|> Option.map List.hd
with
| _ -> None
in
(match content_type with
| Some "multipart/form-data" ->
let* multipart = Opium.Request.to_multipart_form_data_exn req in
let multipart = List.map (fun (k, v) -> k, [ v ]) multipart in
let env = req.Opium.Request.env in
let env = Opium.Context.add key multipart env in
let req = { req with env } in
handler req
| Some "application/x-www-form-urlencoded" ->
let* urlencoded = Opium.Request.to_urlencoded req in
let env = req.Opium.Request.env in
let env = Opium.Context.add key urlencoded env in
let req = { req with env } in
handler req
| _ -> handler req)
| _ ->
let env = req.Opium.Request.env in
let env = Opium.Context.add key [] env in
let req = { req with env } in
handler req
in
Rock.Middleware.create ~name:"formparser" ~filter
;;