mv json.ml api.ml

src/api.ml

@@ -0,0 +1,285 @@
+(* TODO
+   number
+     - number is "float", but we probably want int everywhere instead
+     - numeric values capped at 2^53 -1 inclusive because json
+   time
+     - better types
+     - issues with "never" = uint64_max *)
+open Crypto
+
+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 ErrorDetail = 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 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 Amount = struct
+  include Amount
+
+  let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
+end
+
+module Timestamp = struct
+  type t =
+    | Seconds of float
+    | Never
+
+  let of_ptime p = Seconds (Ptime.to_float_s p)
+
+  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
+
+module RelativeTime = struct
+  type t =
+    | Microseconds of float
+    | Forever
+
+  let number_or_forever_jsont =
+    let forever =
+      let dec s =
+        match s with
+        | "forever" -> Forever
+        | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+      in
+      let enc = function Forever -> "forever" | _ -> assert false in
+      Jsont.map ~dec ~enc Jsont.string
+    in
+    let number =
+      let dec n = Microseconds n in
+      let enc = function Microseconds n -> n | _ -> assert false in
+      Jsont.map ~dec ~enc Jsont.number
+    in
+    let enc = function Forever -> forever | Microseconds _ -> number in
+    Jsont.any ~dec_string:forever ~dec_number:number ~enc ()
+
+  let jsont =
+    let make t_s = t_s in
+    Jsont.Object.map ~kind:"RelativeTime" make
+    |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id
+    |> Jsont.Object.finish
+end
+
+module RsaDenominationKey = struct
+  type t = {
+    age_mask: int;
+    rsa_pub: RsaPublicKey.t;
+  }
+
+  let jsont =
+    let make age_mask rsa_pub = { age_mask; rsa_pub } in
+    let age_mask v = v.age_mask in
+    let rsa_pub v = v.rsa_pub in
+    Jsont.Object.map ~kind:"RsaDenominationKey" make
+    |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
+    |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
+    |> Jsont.Object.finish
+end
+
+(* not acctually implemented *)
+module CSDenominationKey = struct
+  (* Clause Schnorr *)
+  type t = {
+    age_mask: int;
+    cs_pub: string;
+  }
+
+  let jsont =
+    let make age_mask cs_pub = { age_mask; cs_pub } in
+    let age_mask v = v.age_mask in
+    let cs_pub v = v.cs_pub in
+    Jsont.Object.map ~kind:"CSDenominationKey" make
+    |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
+    |> Jsont.Object.mem "cs_pub" Jsont.string ~enc:cs_pub
+    |> Jsont.Object.finish
+end
+
+module DenominationKey = struct
+  type t =
+    | Rsa of RsaDenominationKey.t
+    | CS of CSDenominationKey.t
+
+  let rsa v = Rsa v
+  let cs v = CS v
+
+  let jsont =
+    let open Jsont.Object in
+    let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:rsa in
+    let cs = Case.map "CS" CSDenominationKey.jsont ~dec:cs in
+    let enc_case = function
+      | Rsa v -> Case.value rsa v
+      | CS v -> Case.value cs v
+    in
+    let cases = Case.[ make rsa; make cs ] in
+    map ~kind:"DenominationKey" Fun.id
+    |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
+    |> finish
+end
+
+module FutureSignKey = struct
+  type t = {
+    key: EddsaPublicKey.t;
+    stamp_start: Timestamp.t;
+    stamp_expire: Timestamp.t;
+    stamp_end: Timestamp.t;
+    signkey_secmod_sig: EddsaSignature.t;
+  }
+
+  let jsont =
+    let make key stamp_start stamp_expire stamp_end signkey_secmod_sig =
+      { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+    in
+    let key v = v.key in
+    let stamp_start v = v.stamp_start in
+    let stamp_expire v = v.stamp_expire in
+    let stamp_end v = v.stamp_end in
+    let signkey_secmod_sig v = v.signkey_secmod_sig in
+    let open Jsont.Object in
+    map ~kind:"FutureSignKey" make
+    |> mem "key" EddsaPublicKey.jsont ~enc:key
+    |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+    |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
+    |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
+    |> mem "signkey_secmod_sig" EddsaSignature.jsont ~enc:signkey_secmod_sig
+    |> finish
+end
+
+module FutureDenom = struct
+  type t = {
+    section_name: string;
+    value: Amount.t;
+    stamp_start: Timestamp.t;
+    stamp_expire_withdraw: Timestamp.t;
+    stamp_expire_deposit: Timestamp.t;
+    stamp_expire_legal: Timestamp.t;
+    denom_pub: DenominationKey.t;
+    fee_withdraw: Amount.t;
+    fee_deposit: Amount.t;
+    fee_refresh: Amount.t;
+    fee_refund: Amount.t;
+    denom_secmod_sig: EddsaSignature.t;
+  }
+
+  let jsont =
+    let make section_name value stamp_start stamp_expire_withdraw
+        stamp_expire_deposit stamp_expire_legal denom_pub fee_withdraw
+        fee_deposit fee_refresh fee_refund denom_secmod_sig =
+      {
+        section_name;
+        value;
+        stamp_start;
+        stamp_expire_withdraw;
+        stamp_expire_deposit;
+        stamp_expire_legal;
+        denom_pub;
+        fee_withdraw;
+        fee_deposit;
+        fee_refresh;
+        fee_refund;
+        denom_secmod_sig;
+      }
+    in
+    let section_name t = t.section_name in
+    let value t = t.value in
+    let stamp_start t = t.stamp_start in
+    let stamp_expire_withdraw t = t.stamp_expire_withdraw in
+    let stamp_expire_deposit t = t.stamp_expire_deposit in
+    let stamp_expire_legal t = t.stamp_expire_legal in
+    let denom_pub t = t.denom_pub in
+    let fee_withdraw t = t.fee_withdraw in
+    let fee_deposit t = t.fee_deposit in
+    let fee_refresh t = t.fee_refresh in
+    let fee_refund t = t.fee_refund in
+    let denom_secmod_sig t = t.denom_secmod_sig in
+    let open Jsont.Object in
+    map ~kind:"FutureDenom" make
+    |> mem "section_name" Jsont.string ~enc:section_name
+    |> mem "value" Amount.jsont ~enc:value
+    |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+    |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
+    |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
+    |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
+    |> mem "denom_pub" DenominationKey.jsont ~enc:denom_pub
+    |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
+    |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
+    |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
+    |> mem "fee_refund" Amount.jsont ~enc:fee_refund
+    |> mem "denom_secmod_sig" EddsaSignature.jsont ~enc:denom_secmod_sig
+    |> finish
+end
+
+module FutureKeysResponse = struct
+  type t = {
+    future_denoms: FutureDenom.t list;
+    future_signkeys: FutureSignKey.t list;
+    master_pub: EddsaPublicKey.t;
+    denom_secmod_public_key: EddsaPublicKey.t;
+    signkey_secmod_public_key: EddsaPublicKey.t;
+  }
+
+  let jsont =
+    let make future_denoms future_signkeys master_pub denom_secmod_public_key
+        signkey_secmod_public_key =
+      {
+        future_denoms;
+        future_signkeys;
+        master_pub;
+        denom_secmod_public_key;
+        signkey_secmod_public_key;
+      }
+    in
+    let future_denoms t = t.future_denoms in
+    let future_signkeys t = t.future_signkeys in
+    let master_pub t = t.master_pub in
+    let denom_secmod_public_key t = t.denom_secmod_public_key in
+    let signkey_secmod_public_key t = t.signkey_secmod_public_key in
+    let open Jsont.Object in
+    map ~kind:"FutureKeysResponse" make
+    |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms
+    |> mem "future_signkeys"
+         (Jsont.list FutureSignKey.jsont)
+         ~enc:future_signkeys
+    |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub
+    |> mem "denom_secmod_public_key" EddsaPublicKey.jsont
+         ~enc:denom_secmod_public_key
+    |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont
+         ~enc:signkey_secmod_public_key
+    |> finish
+end