diff --git a/.ocamlformat b/.ocamlformat index 9db5b95d..0b4add55 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -11,3 +11,4 @@ if-then-else=compact break-sequences=false sequence-blank-line=compact exp-grouping=preserve +sequence-blank-line=preserve-one diff --git a/src/dune b/src/dune index 90283be3..9ff5b85a 100644 --- a/src/dune +++ b/src/dune @@ -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) diff --git a/src/json.ml b/src/json.ml new file mode 100644 index 00000000..d0d45254 --- /dev/null +++ b/src/json.ml @@ -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 diff --git a/src/management.ml b/src/management.ml index 320efa92..bae61bef 100644 --- a/src/management.ml +++ b/src/management.ml @@ -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) diff --git a/src/mte.ml b/src/mte.ml index e0cca800..7c551df1 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -14,9 +14,10 @@ along with this program. If not, see . *) 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 diff --git a/src/types.ml b/src/types.ml index 3c32f09f..d2406dec 100644 --- a/src/types.ml +++ b/src/types.ml @@ -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 diff --git a/test/dune b/test/dune new file mode 100644 index 00000000..6d9fb164 --- /dev/null +++ b/test/dune @@ -0,0 +1,4 @@ +(test + (name test) + (modules test) + (libraries types json)) diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 00000000..35da8b25 --- /dev/null +++ b/test/test.ml @@ -0,0 +1,20 @@ +let () = + let open Json in + let check jsont s = + let encode v = encode jsont v |> Result.get_ok in + let decode v = decode jsont v |> Result.get_ok in + let ts = decode s in + let s' = encode ts in + let ts' = decode s' in + let s'' = encode ts' in + assert (String.equal s' s'') + in + let check_bad jsont s = + let decode = decode jsont in + assert (Result.is_error (decode s)) + in + check Timestamp.jsont {|{"t_s": 123456780}|}; + check Timestamp.jsont {|{"t_s": "never"}|}; + check_bad Timestamp.jsont {|{"t_s": "123456780"}|}; + check_bad Timestamp.jsont {|{"t_s": "agagou"}|}; + ()