package sihl-web

  1. Overview
  2. Docs

Source file middleware_urlencoded.ml

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
open Lwt.Syntax
open Sexplib.Std

let log_src = Logs.Src.create "sihl.middleware.urlencoded"

module Logs = (val Logs.src_log log_src : Logs.LOG)

type urlencoded = (string * string list) list [@@deriving sexp]

exception Urlencoded_not_found

let key : urlencoded Opium.Context.key =
  Opium.Context.Key.create ("urlencoded", sexp_of_urlencoded)
;;

let find_all req =
  match Opium.Context.find key req.Opium.Request.env with
  | Some all -> all
  | None ->
    Logs.err (fun m -> m "No parsed urlencoded body found");
    Logs.info (fun m -> m "Have you applied the urlencoded middleware?");
    raise Urlencoded_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 urlencoded body for the key [key]
    and a request with an update context where the parsed urlencoded is missing the key
    [key]. The urlencoded 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 m () =
  let filter handler req =
    let* urlencoded = Sihl_type.Http_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
  in
  Rock.Middleware.create ~name:"urlencoded" ~filter
;;