package ez_api
Easy API library and tools
Install
Dune Dependency
github.com
Readme
Changelog
LGPL-2.1-only WITH OCaml-LGPL-linking-exception License
Edit opam file
Versions (6)
Authors
Maintainers
Sources
v2.0.0.tar.gz
md5=ed68e0a33325ecf6a3319cafa636d62e
sha512=425c6289d568cf697e8d9977ac43e2ebcdeec8f04f5a17225824d5a37ac700961e5d1283b92aeaebaf58ccfb5b4261bcba1180ab11c267ade0de86b68fd6ca2d
doc/src/ez_api.server_utils/ezAPIServerUtils.ml.html
Source file ezAPIServerUtils.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 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 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
(**************************************************************************) (* *) (* Copyright 2018-2023 OCamlPro *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open EzAPI open Lwt.Infix module StringMap = Map.Make(String) module Timings = Timings module Directory = Directory module Answer = Answer module Req = Req module File = File module GMTime = GMTime module Ip = Ip (** Server *) type server_kind = | API of Directory.t | Root of string * string option type server = { server_port : int; server_kind : server_kind; } (** Utils *) let return ?code ?headers x = Answer.return ?code ?headers x let return_ok ?code ?headers x = Answer.return ?code ?headers (Ok x) let return_error ?content ?headers code = Answer.return ~code ?headers (Error content) let verbose = match Sys.getenv_opt "EZAPISERVER" with | None -> ref 0 | Some s -> match int_of_string_opt s with | None -> ref 1 | Some i -> ref i let set_verbose i = verbose := i let pp_time () = GMTime.(date_of_tm @@ Unix.gmtime @@ time ()) let debug ?(v=0) fmt = if !verbose > v then EzDebug.printf fmt else Printf.ifprintf () fmt let debugf ?(v=0) f = if !verbose > v then f () (** Register Handler *) let empty = Directory.empty let register_res service handler dir = let security = Service.security service.s in let path = Service.path service.s in let handler args input = let t0 = (Path.get_root path args).Req.req_time in let add_timing_wrap b = let t1 = GMTime.time () in Timings.add_timing (EzAPI.id service) b t0 (t1-.t0) in Lwt.catch (function () -> handler args security input >>= fun res -> add_timing_wrap true; Lwt.return res) (fun exn -> add_timing_wrap true; Lwt.fail exn) in let service = register service in Directory.register_http dir service handler let register_ws_res service ~react ~bg ?onclose ?step dir = let security = Service.security service.s in let bg r send = bg r security send in let react r i = react r security i in let service = register service in Directory.register_ws dir ?onclose ?step ~react ~bg service exception Conflict of (Directory.Step.t list * Directory.conflict) let register service handler dir = match register_res service handler dir with | Ok dir -> dir | Error (steps, conflict) -> Format.eprintf "Conflict for %s: %s@." (Directory.Step.list_to_string steps) (Directory.conflict_to_string conflict); raise (Conflict (steps, conflict)) let register_ws service ?onclose ?step ~react ~bg dir = match register_ws_res service ?onclose ?step ~react ~bg dir with | Ok dir -> dir | Error (steps, conflict) -> Format.eprintf "Conflict for %s: %s@." (Directory.Step.list_to_string steps) (Directory.conflict_to_string conflict); raise (Conflict (steps, conflict)) module Legacy = struct open Lwt.Infix open EzAPI.Legacy let register (service : ('a, 'b, 'c, 'd) service) handler dir = let handler r sec b = handler r sec b >|= fun r -> {Answer.code=200; body=Ok r; headers=[]} in register service handler dir end let handle ?meth ?content_type ?ws s r path body = let r, body = if content_type = Some Url.content_type then Req.add_params r (Url.decode_args body), "" else r, body in match s with | Root (root, default) -> File.reply ?meth root ?default path >|= fun a -> `http a | API dir -> Directory.lookup ?meth ?content_type dir r path >>= function | Error `Not_found -> Answer.not_found () >|= fun a -> `http a | Error (`Cannot_parse a) -> Answer.cannot_parse a >|= fun a -> `http a | Error `Method_not_allowed -> Answer.method_not_allowed () >|= fun a -> `http a | Ok (`options headers) -> Lwt.return {Answer.code=200; body=""; headers} >|= fun a -> `http a | Ok `head -> Lwt.return {Answer.code=200; body=""; headers =[]} >|= fun a -> `http a | Ok (`http h) -> begin h body >>= function | Error (`destruct_exn exn) -> Answer.destruct_exception exn | Error (`unsupported c) -> Answer.unsupported_media_type c | Error (`handler_error s) -> EzDebug.printf "In %s: error %s" (String.concat "/" path) s; Answer.server_error (Failure s) | Error (`handler_exn exn) -> EzDebug.printf "In %s: exception %s" (String.concat "/" path) @@ Printexc.to_string exn; Answer.server_error exn | Ok a -> Lwt.return a end >|= fun a -> (`http a) | Ok (`ws (react, bg, onclose, step)) -> begin match ws with | None -> assert false | Some ws -> ws ?onclose ?step ~react ~bg r.Req.req_id end >|= fun ra -> `ws ra (* Default access control headers *) let default_access_control_headers = [ "access-control-allow-origin", "*"; "access-control-allow-headers", "accept, content-type" ] (* merge headers correctly with default one *) let merge_headers_with_default headers : (string * string) list = (* combining existing headers *) let l = List.fold_left (fun acc ((hn,hv) as h) -> match List.assoc_opt hn default_access_control_headers with | None -> h::acc | Some _ when hn = "access-control-allow-origin" -> h::acc | Some v when hn = "access-control-allow-headers" -> (hn, hv ^ "," ^ v)::acc | _ -> acc) [] headers in (* Adding default if not present *) List.fold_left (fun acc ((hn,_) as h) -> match List.assoc_opt hn l with | None -> h::acc | _ -> acc ) l default_access_control_headers
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>