add json.ml; add test.ml; timestamp jsont

This commit is contained in:
Swrup 2025-10-03 18:14:17 +02:00
parent 04bb29b30c
commit 724a3d2b68
8 changed files with 89 additions and 22 deletions

View file

@ -1,8 +1,10 @@
(executable
(public_name mte)
(name mte)
(modules assets assets_crunch headers mte config util types management)
(modules assets assets_crunch headers mte config util management)
(libraries
json
types
headers_lib
syntax
;
@ -13,6 +15,16 @@
jsont
cohttp))
(library
(name json)
(modules json)
(libraries jsont jsont.bytesrw fmt syntax types))
(library
(name types)
(modules types)
(libraries fmt syntax))
(library
(name headers_lib)
(modules headers_lib)

46
src/json.ml Normal file
View file

@ -0,0 +1,46 @@
open Types
let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok
let encode jsont v = Jsont_bytesrw.encode_string jsont v
let decode jsont v = Jsont_bytesrw.decode_string jsont v
module Error_detail = struct
open Error_detail
let jsont =
let make code hint = { code; hint } in
let enc_code v = v.code in
let enc_hint v = v.hint in
Jsont.Object.map ~kind:"ErrorDetail" make
|> Jsont.Object.mem "code" Jsont.int ~enc:enc_code
|> Jsont.Object.opt_mem "hint" Jsont.(string) ~enc:enc_hint
|> Jsont.Object.finish
end
module Timestamp = struct
open Timestamp
let number_or_never_jsont =
let never =
let dec s =
match s with
| "never" -> Never
| _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
in
let enc = function Never -> "never" | _ -> assert false in
Jsont.map ~dec ~enc Jsont.string
in
let number =
let dec n = Seconds n in
let enc = function Seconds n -> n | _ -> assert false in
Jsont.map ~dec ~enc Jsont.number
in
let enc = function Never -> never | Seconds _ -> number in
Jsont.any ~dec_string:never ~dec_number:number ~enc ()
let jsont =
let make t_s = t_s in
Jsont.Object.map ~kind:"Timestamp" make
|> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id
|> Jsont.Object.finish
end

View file

@ -29,10 +29,6 @@
Public and private keys are thus 32 bytes, and signatures 64 bytes.
For hashing, including HKDFs, Taler uses 512-bit hash codes (64 bytes). *)
(* TODO big choice
do we re-implement crypto
or do we re-use secmodules with IPC on a Unix domain socket *)
type key =
| Eddsa of Mirage_crypto_ec.Ed25519.(priv * pub)
| Rsa of Mirage_crypto_pk.Rsa.(priv * pub)

View file

@ -14,9 +14,10 @@
along with this program. If not, see <https://www.gnu.org/licenses/>. *)
let error_detail ?hint _status =
let open Types.ErrorDetail in
let open Types.Error_detail in
let open Json in
let code = -1 in
let s = to_string (make code hint) in
let s = encode_exn Error_detail.jsont { code; hint } in
s
module Respond_with = struct

View file

@ -1,28 +1,15 @@
(* https://docs.taler.net/core/api-common.html#tsref-type-ErrorDetail *)
module ErrorDetail = struct
module Error_detail = struct
(* TODO GANA error codes
https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
type t = { code: int; hint: string option }
let make code hint = { code; hint }
let enc_code v = v.code
let enc_hint v = v.hint
let jsont =
Jsont.Object.map ~kind:"ErrorDetail" make
|> Jsont.Object.mem "code" Jsont.int ~enc:enc_code
|> Jsont.Object.opt_mem "hint" Jsont.(string) ~enc:enc_hint
|> Jsont.Object.finish
let to_string v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok
let of_string v = Jsont_bytesrw.decode_string jsont v
end
module Timestamp = struct
(* Seconds since epoch, or the special
value "never" to represent an event that will
never happen. *)
type t = Never | Seconds of int
type t = Never | Seconds of float
end
module Amount = struct