This commit is contained in:
swrup 2025-11-30 14:23:55 +01:00
parent cf4da6b382
commit b79fa883bd
5 changed files with 32 additions and 19 deletions

1
cat.str Normal file
View file

@ -0,0 +1 @@
i love cat

1
download.json Normal file
View file

@ -0,0 +1 @@
{"key":"some value"}

View file

@ -110,9 +110,29 @@ let keys_get req server _env =
let* () = add ~field:"content-type" "application/json" in let* () = add ~field:"content-type" "application/json" in
respond `OK respond `OK
type foo = { key: string }
let foo_jsont =
let open Jsont in
let enc foo = foo.key in
let make key = { key } in
Object.map ~kind:"foo" make |> Object.mem "key" string ~enc |> Object.finish
let keys_post req _server _env = let keys_post req _server _env =
let open Vif.Response in let open Vif.Response in
let open Syntax in let open Syntax in
let* () = with_string req {||} in match Vif.Request.of_json req with
let* () = add ~field:"content-type" "application/json" in | Ok (foo : foo) ->
respond `OK let str = Fmt.str "key: %s@." foo.key in
let* () =
Vif.Response.add ~field:"content-type" "text/plain; charset=utf-8"
in
let* () = Vif.Response.with_string req str in
Vif.Response.respond `OK
| Error (`Msg msg) ->
Logs.err (fun m -> m "Invalid JSON: %s" msg);
let* () =
Vif.Response.add ~field:"content-type" "text/plain; charset=utf-8"
in
let* () = Vif.Response.with_string req msg in
Vif.Response.respond (`Code 422)

View file

@ -33,7 +33,10 @@ let routes =
get_ (rel / "privacy" /?? nil) --> Static.privacy; get_ (rel / "privacy" /?? nil) --> Static.privacy;
get_ (rel / "test" /?? nil) --> Database.test_activate; get_ (rel / "test" /?? nil) --> Database.test_activate;
get_ (rel / "management" / "keys" /?? nil) --> Management.keys_get; get_ (rel / "management" / "keys" /?? nil) --> Management.keys_get;
post (rel / "management" / "keys" /?? nil) any --> Management.keys_post; post
(rel / "management" / "keys" /?? nil)
(json_encoding Management.foo_jsont)
--> Management.keys_post;
] ]
let () = let () =

View file

@ -1,6 +1,5 @@
(* TODO (* TODO
- clean up cmdliner - clean up cmdliner
- don't depends on wget
- setup: need public key in config file - setup: need public key in config file
- check sigs *) - check sigs *)
(* doc: https://docs.taler.net/manpages/taler-exchange-offline.1.html *) (* doc: https://docs.taler.net/manpages/taler-exchange-offline.1.html *)
@ -11,26 +10,15 @@ let download ~base_url ~output =
let uri = let uri =
Uri.with_path (Uri.of_string base_url) "/management/keys/" |> Uri.to_string Uri.with_path (Uri.of_string base_url) "/management/keys/" |> Uri.to_string
in in
let wget = Cmd.(v "wget" % "-O" % output % uri) in OS.Cmd.run Cmd.(v "hurl" % "--output" % output % uri)
OS.Cmd.run wget
let upload ~base_url ~input = let upload ~base_url ~input =
let open Bos in let open Bos in
let uri = let uri =
Uri.with_path (Uri.of_string base_url) "/management/keys/" |> Uri.to_string Uri.with_path (Uri.of_string base_url) "/management/keys/" |> Uri.to_string
in in
let wget = OS.Cmd.run
Cmd.( Cmd.(v "hurl" % "--method" % "POST" % "--json-input" % ("@=" ^ input) % uri)
v "wget"
% "--method=POST"
% "--header='Content-Type: application/json'"
% "--body-file"
% input
% "-O"
% "/dev/null"
% uri)
in
OS.Cmd.run wget
let setup ~output = let setup ~output =
let output = Fpath.v output in let output = Fpath.v output in