blob: e8e7db4e2f31c4eeeadc1423d782a6f0361c7963 (
plain)
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
|
open Piaf
(* open Result_syntax *)
open Eio.Std
type mode =
| Hx
| HxSwap
| Server
let query_param uri param =
match Uri.query uri |> List.assoc_opt param with
| Some [ param ] -> Some param
| _ -> None
;;
let send_raw_html ?(headers = []) ?(status = `OK) body =
let headers =
Headers.(of_list ([ Well_known.content_type, "text/html; charset=utf-8" ] @ headers))
in
Response.of_string ~headers ~body status
;;
let piaf_config = { Piaf.Config.default with follow_redirects = true }
(* let get env ~headers ~sw url = *)
(* TODO: curl-style debug logging *)
(* let result = *)
(* let* response = *)
(* Client.Oneshot.get ~headers ~config:piaf_config ~sw env (Uri.of_string url) *)
(* in *)
(* let body = Body.to_string response.body in *)
(* if Status.is_successful response.status *)
(* then body *)
(* else *)
(* let* body = body in *)
(* let message = Status.to_string response.status in *)
(* Error (`Msg (Format.sprintf "%s %s" message body)) *)
(* in *)
(* result |> Result.map_error Error.to_string *)
(* ;; *)
(* let post env ~body ~headers ~sw url = *)
(* TODO: curl-style debug logging *)
(* let result = *)
(* let* response = *)
(* Client.Oneshot.post ~headers ~body ~config:piaf_config ~sw env (Uri.of_string url) *)
(* in *)
(* let body = Body.to_string response.body in *)
(* if Status.is_successful response.status *)
(* then body *)
(* else *)
(* let* body = body in *)
(* let message = Status.to_string response.status in *)
(* Error (`Msg (Format.sprintf "%s %s" message body)) *)
(* in *)
(* result |> Result.map_error Error.to_string *)
(* ;; *)
(* let parse_form_body ctx = *)
(* let result = *)
(* let+ body = ctx.Piaf.Server.request.body |> Body.to_string in *)
(* body *)
(* |> String.split_on_char '&' *)
(* |> List.filter_map (fun pair -> *)
(* match pair |> String.split_on_char '=' with *)
(* | [ key; value ] -> *)
(* let key = Uri.pct_decode key in *)
(* let value = Uri.pct_decode value in *)
(* Some (key, value) *)
(* | parts -> *)
(* traceln "Ignoring invalid param %s" (String.concat "," parts); *)
(* None) *)
(* in *)
(* result |> Result.map_error (Fmt.to_to_string Piaf.Error.pp_hum) *)
(* ;; *)
let form_field field params =
params
|> List.assoc_opt field
|> Option.to_result ~none:(Format.sprintf "Missing %s field" field)
;;
let handle_error result =
result
|> Result.fold ~ok:Fun.id ~error:(fun error ->
traceln "Failed handling request %s" error;
Piaf.Response.create `Internal_server_error)
;;
|
