src/mte.ml

@@ -13,90 +13,6 @@
     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/>. *)
 
-let error_detail ?hint _status =
-  let open Api in
-  let code = -1 in
-  let s = encode_exn ErrorDetail.jsont { 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" Assets.terms_legal_version
-            in
-            let* () =
-              add ~field:"avail-languages" Headers.avail_languages_header_value
-            in
-            let* () =
-              let content_type = Fmt.str "%a" Assets.Mimetype.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

src/static.ml

@@ -0,0 +1,83 @@
+(* 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 Respond_with = struct
+  open Vif.Response
+  open Syntax
+
+  open struct
+    let error_detail ?hint _status =
+      let open Api in
+      let code = -1 in
+      let s = encode_exn ErrorDetail.jsont { code; hint } in
+      s
+  end
+
+  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
+
+let aux 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" Assets.terms_legal_version
+          in
+          let* () =
+            add ~field:"avail-languages" Headers.avail_languages_header_value
+          in
+          let* () =
+            let content_type = Fmt.str "%a" Assets.Mimetype.pp_mime mime in
+            add ~field:"content-type" content_type
+          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