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
+  let opt = Vif.Headers.get headers "accept" in
-  Cohttp.Accept.media_ranges accept
+  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
+  let opt = Vif.Headers.get headers "accept-language" in
-  Cohttp.Accept.languages accept_language
+  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"
+  let opt = Vif.Headers.get headers "accept-encoding" in
-  |> Cohttp.Accept.encodings
+  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

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 =

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
+  | Error e ->
-  | Ok true -> Respond_with.not_modified ()
+      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
+(* WIP DEBUG *)
-let privacy req _server _env = aux Assets.Privacy req _server _env
+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

test/test.ml

@@ -106,5 +106,17 @@ 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
+  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');
+  assert (v = v');
+  ()