wip basic error response

src/mte.ml

@@ -13,6 +13,29 @@
     You should have received a copy of the GNU Affero General Public License
     along with this program.  If not, see <https://www.gnu.org/licenses/>. *)
 
+(* TODO *)
+(* https://docs.taler.net/core/api-common.html#tsref-type-ErrorDetail *)
+let error_detail ?hint status =
+  let _ = (hint, status) in
+  "{}"
+
+module Respond_with = struct
+  open Vif.Response
+  open Syntax
+
+  let not_modified () =
+    let* () = empty in
+    respond `Not_modified
+
+  let unsupported_media_type req =
+    let body =
+      error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
+    in
+    let* () = with_string ?compression:None req body in
+    let* () = add ~field:"accept" Headers.accept_header_value in
+    respond `Unsupported_media_type
+end
+
 (* TODO check for mathcing ETAG with a middleware instead? *)
 (* /terms + /privacy
    - try to find a response with an acceptable mime-type
@@ -24,7 +47,7 @@
    - When returning a full response (not a "304 Not Modified"),
      include a "Avail-Languages" header: a comma-separated list of the languages available *)
 module Static = struct
-  let static kind req _server _env =
+  let f kind req _server _env =
     let get_ok = function
       | Error e -> Fmt.failwith "TODO handle me, %s" e
       | Ok v -> v
@@ -38,46 +61,45 @@ module Static = struct
           Headers_lib.Etag.parse s |> get_ok |> Headers_lib.Etag.evaluate etag
     in
     match has_matching_etag with
-    | true ->
-        let open Vif.Response.Syntax in
-        let* () = Vif.Response.empty in
-        Vif.Response.respond `Not_modified
-    | false ->
-        let mime = Headers.select_mimetype headers |> get_ok in
-        let lang = Headers.select_language headers |> get_ok in
-        let compression = Headers.select_encoding headers in
-        let data = Assets.get_content ~mime ~lang kind in
-        (* -- *)
-        let open Vif.Response.Syntax in
-        let* () = Vif.Response.with_string ?compression req data in
-        let* () =
-          let etag_field_value = Headers_lib.Etag.to_field_value etag in
-          Vif.Response.add ~field:"etag" etag_field_value
-        in
-        let* () =
-          (* todo: is it "taler-privacy-version" for /policy ? *)
-          Vif.Response.add ~field:"taler-terms-version"
-            Config.terms_legal_version
-        in
-        let* () =
-          Vif.Response.add ~field:"avail-languages"
-            Headers.avail_languages_header_value
-        in
-        let* () =
-          let content_type = Fmt.str "%s/%s" (fst mime) (snd mime) in
-          Vif.Response.add ~field:"content-type" content_type
-        in
-        Vif.Response.respond `OK
+    | true -> Respond_with.not_modified ()
+    | false -> (
+        match Headers.select_mimetype headers with
+        | None -> Respond_with.unsupported_media_type req
+        | Some mime ->
+            let lang = Headers.select_language headers in
+            let compression = Headers.select_encoding headers in
+            let data = Assets.get_content ~mime ~lang kind in
+            (* -- *)
+            let open Vif.Response in
+            let open Syntax in
+            let* () = with_string ?compression req data in
+            let* () =
+              let etag_field_value = Headers_lib.Etag.to_field_value etag in
+              add ~field:"etag" etag_field_value
+            in
+            let* () =
+              (* todo: is it "taler-privacy-version" for /policy ? *)
+              add ~field:"taler-terms-version" Config.terms_legal_version
+            in
+            let* () =
+              add ~field:"avail-languages" Headers.avail_languages_header_value
+            in
+            let* () =
+              let content_type = Fmt.str "%a" Util.pp_mime mime in
+              add ~field:"content-type" content_type
+            in
+            respond `OK)
 
-  let terms = static Assets.Terms
-  let privacy = static Assets.Privacy
+  let terms = f Assets.Terms
+  let privacy = f Assets.Privacy
 end
 
 let hello req _server _env =
-  let open Vif.Response.Syntax in
-  let* () = Vif.Response.with_string req "Hello~~\n" in
-  let* () = Vif.Response.add ~field:"content-type" "text/plain" in
-  Vif.Response.respond `OK
+  let open Vif.Response in
+  let open Syntax in
+  let* () = with_string req "Hello~~\n" in
+  let* () = add ~field:"content-type" "text/plain" in
+  respond `OK
 
 let routes =
   let open Vif.Uri in