diff --git a/src/devices.ml b/src/devices.ml index 4b3527b9..6a37b593 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -1,4 +1,4 @@ -let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device +let db_connection caqti_switch : (unit, Caqti_miou.connection) Vifu.Device.device = let f () = let db_uri = Config.Exchangedb_postgres.config in @@ -14,7 +14,7 @@ let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device conn) in let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in - Vif.Device.v ~name:"db_connection" ~finally [] f + Vifu.Device.v ~name:"db_connection" ~finally [] f let keys storage = let f (module Conn : Pg.CONN) () = @@ -27,4 +27,4 @@ let keys storage = keys in let finally _key = () in - Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] f + Vifu.Device.v ~name:"keys" ~finally [ Vifu.Device.value db_connection ] f diff --git a/src/headers.ml b/src/headers.ml index 6d4a64f7..97678517 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -9,7 +9,7 @@ let avail_languages_header_value = (* TODO better headers_lib Cohttp raises on invalid *) let select_mimetype headers = - let opt = Vif.Headers.get headers "accept" in + let opt = Vifu.Headers.get headers "accept" in Cohttp.Accept.media_ranges opt |> Cohttp.Accept.qsort |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp m) @@ -18,7 +18,7 @@ let select_mimetype headers = | Some mime -> mime let select_language headers = - let opt = Vif.Headers.get headers "accept-language" in + let opt = Vifu.Headers.get headers "accept-language" in Cohttp.Accept.languages opt |> Cohttp.Accept.qsort |> List.map snd @@ -28,7 +28,7 @@ let select_language headers = | Some lang -> lang let select_encoding headers = - let opt = Vif.Headers.get headers "accept-encoding" in + let opt = Vifu.Headers.get headers "accept-encoding" in Cohttp.Accept.encodings opt |> Cohttp.Accept.qsort |> List.map snd diff --git a/src/mte.ml b/src/mte.ml index 296319b0..55da93d9 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -14,17 +14,17 @@ along with this program. If not, see . *) let hello req _server _env = - let open Vif.Response in + let open Vifu.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 Vifu.Uri in + let open Vifu.Route in let get path = get (path /?? any) in - let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in + let post path jsont = post (Vifu.Type.json_encoding jsont) (path /?? any) in let v s = rel / s in let tos = [ @@ -133,9 +133,9 @@ let () = let env : Devices.env = { caqti_switch; db_uri= Config.Exchangedb_postgres.config } in - let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in - let middlewares = Vif.Middlewares.[] in + let devices = Vifu.Devices.[ Devices.db_connection; Devices.keys ] in + let middlewares = Vifu.Middlewares.[] in Logs.info (fun m -> m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); - Vif.run ~cfg ~devices ~middlewares routes env + Vifu.run ~cfg ~devices ~middlewares routes env *) diff --git a/src/mte_info.ml b/src/mte_info.ml index 60c5bf59..9b7f13ab 100644 --- a/src/mte_info.ml +++ b/src/mte_info.ml @@ -7,9 +7,9 @@ module String_map = Stdlib.Map.Make (Stdlib.String) maybe don't use the same RNG-initialization as the one used to generate keys *) let seed req _server _env = Logs.info (fun m -> m "GET /seed"); - (* RNG is initialized by Vif.run *) + (* RNG is initialized by Vifu.run *) let s = Mirage_crypto_rng.generate 64 in - let open Vif.Response in + let open Vifu.Response in let open Syntax in let* () = add ~field:"content-type" "application/octet-stream" in let* () = with_string req s in @@ -158,11 +158,11 @@ let jsont = ExchangeKeysResponse.jsont let keys req server _env = Logs.info (fun m -> m "GET /keys"); - let db_conn = Vif.Server.device Devices.db_connection server in - let keys = Vif.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in let res = let* last_issue_date = - match Vif.Queries.get req "last_issue_date" with + match Vifu.Queries.get req "last_issue_date" with | [] -> Ok None | s :: _ -> ( match Int64.of_string_opt s with diff --git a/src/mte_management.ml b/src/mte_management.ml index d289678f..b22331cc 100644 --- a/src/mte_management.ml +++ b/src/mte_management.ml @@ -7,7 +7,7 @@ module Keys_get = struct let f req server _env = Logs.info (fun m -> m "GET /management/keys/"); - let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in + let (module Keys : Keys.S) = Vifu.Server.device Devices.keys server in let res = let* v = Keys.make_future_keys_response () in Api.encode jsont v @@ -31,9 +31,9 @@ module Keys_post = struct let f req server _env = Logs.info (fun m -> m "POST /management/keys/"); - let keys = Vif.Server.device Devices.keys server in + let keys = Vifu.Server.device Devices.keys server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ keys v in Ok () @@ -56,10 +56,10 @@ module Denom_revoke = struct let f req h_denom_pub server _env = Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); - let keys = Vif.Server.device Devices.keys server in + let keys = Vifu.Server.device Devices.keys server in let res = let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys h_denom_pub v in let* () = do_ keys h_denom_pub v in Ok () @@ -82,10 +82,10 @@ module Signkey_revoke = struct let f req exchange_pub server _env = Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); - let keys = Vif.Server.device Devices.keys server in + let keys = Vifu.Server.device Devices.keys server in let res = let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys exchange_pub v in let* () = do_ keys exchange_pub v in Ok () @@ -133,10 +133,10 @@ module Auditors = struct let f req server _env = Logs.info (fun m -> m "POST /management/auditors/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -178,11 +178,11 @@ module Auditors_disable = struct let f req auditor_pub server _env = Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in Ok () @@ -238,10 +238,10 @@ module Wire_fee = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire-fee/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -284,9 +284,9 @@ module Global_fees = struct and once set for a timeframe, it should not change. *) let f req server _env = Logs.info (fun m -> m "POST /management/global-fees/"); - let db_conn = Vif.Server.device Devices.db_connection server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify v in let* () = do_ ~db_conn v in Ok () @@ -399,10 +399,10 @@ module Wire = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -438,10 +438,10 @@ module Wire_disable = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/disable/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -487,10 +487,10 @@ module Drain = struct let f req server _env = Logs.info (fun m -> m "POST /management/drain/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -527,10 +527,10 @@ module AmlOfficer = struct let f req server _env = Logs.info (fun m -> m "POST /management/aml-officers/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -569,10 +569,10 @@ module Partners = struct let f req server _env = Logs.info (fun m -> m "POST /management/partners/"); - let keys = Vif.Server.device Devices.keys server in - let db_conn = Vif.Server.device Devices.db_connection server in + let keys = Vifu.Server.device Devices.keys server in + let db_conn = Vifu.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_msg in + let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () diff --git a/src/mte_terms.ml b/src/mte_terms.ml index 4dca972a..a055b5e4 100644 --- a/src/mte_terms.ml +++ b/src/mte_terms.ml @@ -2,9 +2,9 @@ let aux asset req _server _env = let etag = Assets.etag asset in - let headers = Vif.Request.headers req in + let headers = Vifu.Request.headers req in let has_matching_etag = - match Vif.Headers.get headers "if-none-match" with + match Vifu.Headers.get headers "if-none-match" with | None -> Ok false | Some s -> Headers_lib.If_none_match.parse s @@ -19,7 +19,7 @@ let aux asset req _server _env = let compression = Headers.select_encoding headers in let data = Assets.get_content ~mime ~lang asset in (* -- *) - let open Vif.Response in + let open Vifu.Response in let open Syntax in let* () = with_string ?compression req data in let* () = diff --git a/src/respond.ml b/src/respond.ml index a7780c36..60fb46a3 100644 --- a/src/respond.ml +++ b/src/respond.ml @@ -4,7 +4,7 @@ let encode_error_detail err = | Ok s -> s let respond_json req content status = - let open Vif.Response in + let open Vifu.Response in let open Syntax in let* () = add ~field:"content-type" "application/json" in let* () = with_string req content in @@ -32,14 +32,14 @@ let ok content req = let no_content () = Logs.debug (fun m -> m "no content"); - let open Vif.Response in + let open Vifu.Response in let open Syntax in let* () = empty in respond `No_content let not_modified () = Logs.debug (fun m -> m "not modified"); - let open Vif.Response in + let open Vifu.Response in let open Syntax in let* () = empty in respond `Not_modified