wip debug
This commit is contained in:
parent
84a0543a50
commit
2f2befa1f6
6 changed files with 66 additions and 15 deletions
|
|
@ -19,11 +19,13 @@ module Respond_with = struct
|
|||
let code = -1 in
|
||||
let err = ErrorDetail.make ?hint code in
|
||||
let s = encode_exn ErrorDetail.jsont err in
|
||||
Logs.err (fun m -> m "ErrorDetail: `%s`" s);
|
||||
s
|
||||
end
|
||||
|
||||
let bad_request ?hint req =
|
||||
let body = error_detail ?hint `Bad_request in
|
||||
let* () = add ~field:"content-type" "application/json" in
|
||||
let* () = with_string ?compression:None req body in
|
||||
respond `Bad_request
|
||||
|
||||
|
|
@ -35,12 +37,13 @@ module Respond_with = struct
|
|||
let body =
|
||||
error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
|
||||
in
|
||||
let* () = with_string ?compression:None req body in
|
||||
let* () = add ~field:"content-type" "application/json" in
|
||||
let* () = add ~field:"accept" Headers.accept_header_value in
|
||||
let* () = with_string ?compression:None req body in
|
||||
respond `Unsupported_media_type
|
||||
end
|
||||
|
||||
let aux kind req _server _env =
|
||||
let _aux kind req _server _env =
|
||||
let etag = Assets.etag kind in
|
||||
let headers = Vif.Request.headers req in
|
||||
let has_matching_etag =
|
||||
|
|
@ -50,11 +53,17 @@ let aux kind req _server _env =
|
|||
Headers_lib.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
|
||||
in
|
||||
match has_matching_etag with
|
||||
| Error e -> Respond_with.bad_request ~hint:e req
|
||||
| Ok true -> Respond_with.not_modified ()
|
||||
| Error e ->
|
||||
Logs.err (fun m -> m "bad request");
|
||||
Respond_with.bad_request ~hint:e req
|
||||
| Ok true ->
|
||||
Logs.err (fun m -> m "not modified");
|
||||
Respond_with.not_modified ()
|
||||
| Ok false -> (
|
||||
match Headers.select_mimetype headers with
|
||||
| None -> Respond_with.unsupported_media_type req
|
||||
| None ->
|
||||
Logs.err (fun m -> m "unsupported_media_type");
|
||||
Respond_with.unsupported_media_type req
|
||||
| Some mime ->
|
||||
let lang = Headers.select_language headers in
|
||||
let compression = Headers.select_encoding headers in
|
||||
|
|
@ -80,5 +89,27 @@ let aux kind req _server _env =
|
|||
in
|
||||
respond `OK)
|
||||
|
||||
let terms req _server _env = aux Assets.Terms req _server _env
|
||||
let privacy req _server _env = aux Assets.Privacy req _server _env
|
||||
(* WIP DEBUG *)
|
||||
let aux _kind req _server _env =
|
||||
let open Vif.Response in
|
||||
let open Syntax in
|
||||
let data = "uhuh" in
|
||||
let etag = "0" in
|
||||
let content_type = "text/plain" in
|
||||
let* () = with_string req data in
|
||||
let* () = add ~field:"etag" etag in
|
||||
let* () =
|
||||
(* todo: is it "taler-privacy-version" for /policy ? *)
|
||||
add ~field:"taler-terms-version" Assets.terms_legal_version
|
||||
in
|
||||
let* () = add ~field:"avail-languages" Headers.avail_languages_header_value in
|
||||
let* () = add ~field:"content-type" content_type in
|
||||
respond `OK
|
||||
|
||||
let terms req _server _env =
|
||||
Logs.info (fun m -> m "GET /terms");
|
||||
aux Assets.Terms req _server _env
|
||||
|
||||
let privacy req _server _env =
|
||||
Logs.info (fun m -> m "GET /privacy");
|
||||
aux Assets.Privacy req _server _env
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue