From 0fd45ae1e784730dc7b17c9c63cd2436ef1f2678 Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 6 Feb 2026 18:30:32 +0100 Subject: [PATCH] wip debug --- src/headers.ml | 21 +++++++++++++++------ src/http_keys.ml | 5 ++++- src/static.ml | 45 ++++++++++++++++++++++++++++++++++++++------- test/test.ml | 20 +++++++++++++++++++- 4 files changed, 76 insertions(+), 15 deletions(-) diff --git a/src/headers.ml b/src/headers.ml index ae740b4f..f41fc976 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -13,15 +13,21 @@ let avail_languages_header_value = s let select_mimetype headers = - let accept = Vif.Headers.get headers "accept" in - Cohttp.Accept.media_ranges accept + let opt = Vif.Headers.get headers "accept" in + Logs.err (fun m -> + let s = Option.value ~default:"none" opt in + m "Header accept: %s" s); + Cohttp.Accept.media_ranges opt |> Cohttp.Accept.qsort |> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m) |> List.find_opt Assets.is_supported_mimetype let select_language headers = - let accept_language = Vif.Headers.get headers "accept-language" in - Cohttp.Accept.languages accept_language + let opt = Vif.Headers.get headers "accept-language" in + Logs.err (fun m -> + let s = Option.value ~default:"none" opt in + m "Header accept-language: %s" s); + Cohttp.Accept.languages opt |> Cohttp.Accept.qsort |> List.map (fun (_q, lang) -> lang) |> List.map (function @@ -35,8 +41,11 @@ let select_language headers = |> Option.value ~default:Assets.default_lang let select_encoding headers = - Vif.Headers.get headers "accept-encoding" - |> Cohttp.Accept.encodings + let opt = Vif.Headers.get headers "accept-encoding" in + Logs.err (fun m -> + let s = Option.value ~default:"none" opt in + m "Header accept-encoding: %s" s); + Cohttp.Accept.encodings opt |> Cohttp.Accept.qsort |> List.map snd |> List.filter_map (function diff --git a/src/http_keys.ml b/src/http_keys.ml index 0fd92a81..eaea4776 100644 --- a/src/http_keys.ml +++ b/src/http_keys.ml @@ -190,7 +190,10 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = let recoup = (* TODO /recoup *) [] in let* global_fees = + (* WIP DEBUG Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti + *) + Ok [] in let* auditors = (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) @@ -241,7 +244,7 @@ let jsont = ExchangeKeysResponse.jsont (* TODO query param ?last_issue_date *) let f req server _env = - Logs.info (fun m -> m "GET /keys/"); + Logs.info (fun m -> m "GET /keys"); let db_conn = Vif.Server.device Devices.db_connection server in let sm = Vif.Server.device Devices.secmod server in let res = diff --git a/src/static.ml b/src/static.ml index 57b24dcd..52a7278d 100644 --- a/src/static.ml +++ b/src/static.ml @@ -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 diff --git a/test/test.ml b/test/test.ml index 03831efc..21803e30 100644 --- a/test/test.ml +++ b/test/test.ml @@ -106,5 +106,23 @@ let () = Printf.printf "%s" raw_str; *) () - *) + +let () = + let v = + "04000274VF2F65WWABKGZYHREQWAFTVPMWEK9EQYMCPP1E6CMC224XDDDBVM7NRMNDX3TETHTK5G7GPPPYGN08FEMSY6B7NGBE8AYMG5HWT2BXRSAHAWDWW5Y16YVGXJG0BCKW3X17EWEF8MNGFGJBKVWQV5WPT0R2QK82QXFHFVGP3HR1D8HF69JXBC22B62M4SFETRJNXRG2GXX03BETSNQW0X7BYTMFJX5JQH4B2KJMABB02RFSNNMND7CT7MSAX5SCZY5ZB9XS4ZDKA9AVTS11V790KXXBSFZSD3NNEHKB6RS99RJD3MDJE04G1Q83HR50N5NVBDW3HPJZKQS5SSG7R2R2F7K8P06HJ4YSQFF52GF3RZW22N4FRQ28KQ2JZMZ1GJS1KBNHNNMS1RW9DZQ3882Z5V0000000004002===" + in + let decode s = B32.decode s |> get_ok in + let v' = B32.encode (decode v) in + let v'' = B32.encode (decode v') in + (* + Fmt.pr "v : %s@." v; + Fmt.pr "v' : %s@." v'; + Fmt.pr "v'': %s@." v''; + Fmt.pr "len v : %d@." (String.length v); + Fmt.pr "len v' : %d@." (String.length v'); + Fmt.pr "len v'': %d@." (String.length v''); + *) + assert (v = v'); + assert (v' = v''); + ()