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

.ocamlformat

@@ -11,3 +11,4 @@ if-then-else=compact
 break-sequences=false
 sequence-blank-line=compact
 exp-grouping=preserve
+sequence-blank-line=preserve-one

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)

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

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)

src/mte.ml

@@ -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

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

test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (modules test)
+ (libraries types json))

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"}|};
+  ()