(* MTE - the MirageOS Taler Exchange Copyright (C) 2025 Olivier Pierre This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, version 3. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of the GNU Affero General Public License along with this program. If not, see . *) let error_detail ?hint _status = let open Types.ErrorDetail in let code = -1 in let s = to_string (make code hint) in s module Respond_with = struct open Vif.Response open Syntax let bad_request ?hint req = let body = error_detail ?hint `Bad_request in let* () = with_string ?compression:None req body in respond `Bad_request 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 - pick the version in the most preferred language of the user - apply compression if that is allowed by the client - set ETAG header - If it did not change, a "304 Not Modified" response will be returned - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms - 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 f kind req _server _env = let etag = Assets.etag kind in let headers = Vif.Request.headers req in let has_matching_etag = match Vif.Headers.get headers "if-none-match" with | None -> Ok false | Some s -> 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 () | Ok 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 = f Assets.Terms let privacy = f Assets.Privacy end let hello req _server _env = 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 let open Vif.Route in (*let open Vif.Type in*) [ get (rel /?? nil) --> hello; get (rel / "terms" /?? nil) --> Static.terms ; get (rel / "privacy" /?? nil) --> Static.privacy ] let () = let cfg = let port = 3696 in let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in Vif.config sockaddr in Miou_unix.run @@ fun () -> let env = () in let middlewares = Vif.Middlewares.[] in Vif.run ~cfg ~middlewares routes env