add timestamps; use Ptime

src/binary_formats.ml

@@ -22,6 +22,8 @@
      exchange and gana master branch are not in sync
      and we should use a specific git tag instead *)
 
+module Taler_signatures = Include.Taler_signatures
+
 (* -- Crypto keys -- *)
 
 module RsaPublicKey = struct
@@ -77,13 +79,12 @@ module RsaPublicKey = struct
     |> sealr
 end
 
-open Include
-
 let int32_size = 4
 let int64_size = 8
 
 (* -- Time -- *)
 
+(* microseconds since the UNIX Epoch. UINT64_MAX represents "never" *)
 module MK_TIME () = struct
   type t = { v: int64 }
 

src/config.ml

@@ -1,6 +1,8 @@
 (* hardcoded config for now *)
 
 let amount s = Amount.of_string s |> Result.get_ok
+let zero_eur = amount "EUR:0.01"
+let dummy_duration = Ptime.Span.of_int_s 99999999
 
 module Exchange = struct
   let currency = "EUR"
@@ -9,10 +11,10 @@ module Exchange = struct
   let attribute_encryption_key = "uhuhg" (* high-entropy nonce. *)
   let port = 3696
   let master_public_key = "uhuhg"
-  let stefan_abs = amount "EUR:0.00"
+  let stefan_abs = zero_eur
-  let stefan_log = amount "EUR:0.00"
+  let stefan_log = zero_eur
   let stefan_lin = 0.0
-  let signkey_legal_duration = 99999999
+  let signkey_legal_duration = dummy_duration
   let max_keys_caching = 9999999
   let max_requests = 99999999
   let terms_dir = Fpath.(v "terms")
@@ -35,15 +37,15 @@ let currency_eur =
     }
 
 module Secmod_rsa = struct
-  let lookahead_sign = 9999999
+  let lookahead_sign = dummy_duration
-  let overlap_duration = 9999999
+  let overlap_duration = dummy_duration
   let sm_priv_key = Fpath.(v "rsa_key.priv")
   let key_dir = Fpath.(v "rsa")
 end
 
 module Secmod_eddsa = struct
-  let lookahead_sign = 9999999
+  let lookahead_sign = dummy_duration
-  let overlap_duration = 9999999
+  let overlap_duration = dummy_duration
   let sm_priv_key = Fpath.(v "eddsa_key.priv")
   let key_dir = Fpath.(v "eddsa")
 end
@@ -53,15 +55,15 @@ let coin_kudo_1 =
     {
       section_name= "kudo_1";
       value= amount "EUR:0.01";
-      duration_withdraw= 999999;
+      duration_withdraw= dummy_duration;
-      duration_spend= 999999;
+      duration_spend= dummy_duration;
-      duration_legal= 999999;
+      duration_legal= dummy_duration;
-      fee_withdraw= amount "EUR:0.00";
+      fee_withdraw= zero_eur;
-      fee_deposit= amount "EUR:0.00";
+      fee_deposit= zero_eur;
-      fee_refresh= amount "EUR:0.00";
+      fee_refresh= zero_eur;
-      fee_refund= amount "EUR:0.00";
+      fee_refund= zero_eur;
       cipher= `RSA;
-      rsa_keysize= Some 2048;
+      rsa_keysize= 2048;
       age_restricted= `NO;
     }
 

src/dune

@@ -22,7 +22,8 @@
   vif
   fmt
   jsont
-  cohttp))
+  cohttp
+  ptime))
 
 (library ; crockford base32
  (name b32)

src/management.ml

@@ -2,7 +2,7 @@ open Types
 
 (* TODO
    - take secmod devices as param
-   - key stamp/time stuff
+   - time stuff
    - hash stuff
      what is the hash algorithm
      is it hash'ed then base32'ed in xxxP?
@@ -11,30 +11,27 @@ open Types
 let mk_denomination_key rsa_pub =
   DenominationKey.Rsa RsaDenominationKey.{ age_mask= 0; rsa_pub }
 
-let mk_future_denom denom_secmod_sign_f (denom : Secmod_denom.rsa) =
+let mk_future_denom denom_secmod_sign_f
-  let Config_types.Coin.
+    ({
-        {
        section_name;
        value;
-          duration_withdraw= _;
+       stamp_start;
-          duration_spend= _;
+       stamp_expire_withdraw;
-          duration_legal= _;
+       stamp_expire_deposit;
+       stamp_expire_legal;
        fee_withdraw;
        fee_deposit;
        fee_refresh;
        fee_refund;
-          cipher= _;
+       pub;
-          rsa_keysize= _;
+       sign= _;
-          age_restricted= _;
+     } :
-        } =
+      Secmod_denom.rsa_denom) =
-    denom.coin
+  let denom_pub = mk_denomination_key pub in
-  in
-  let denom_pub = mk_denomination_key denom.pub in
-  let stamp_x = Timestamp.Never in
   let ps =
     let h_denom_pub =
       (* TODO hash *)
-      let v = denom.pub |> RsaPublicKey.to_string in
+      let v = pub |> RsaPublicKey.to_string in
       Binary_formats.DenominationHash.{ v= { v } }
     in
     let h_section_name =
@@ -64,10 +61,10 @@ let mk_future_denom denom_secmod_sign_f (denom : Secmod_denom.rsa) =
     {
       section_name;
       value;
-      stamp_start= stamp_x;
+      stamp_start= Timestamp.of_ptime stamp_start;
-      stamp_expire_withdraw= stamp_x;
+      stamp_expire_withdraw= Timestamp.of_ptime stamp_expire_withdraw;
-      stamp_expire_deposit= stamp_x;
+      stamp_expire_deposit= Timestamp.of_ptime stamp_expire_deposit;
-      stamp_expire_legal= stamp_x;
+      stamp_expire_legal= Timestamp.of_ptime stamp_expire_legal;
       denom_pub;
       fee_withdraw;
       fee_deposit;
@@ -76,10 +73,8 @@ let mk_future_denom denom_secmod_sign_f (denom : Secmod_denom.rsa) =
       denom_secmod_sig;
     }
 
-let mk_future_sign_key signkey_secmod_sign_f exchange_pub_key =
+let mk_future_sign_key signkey_secmod_sign_f
-  let stamp_start = Timestamp.Seconds 0.0 in
+    ({ pub; sign= _; stamp_start; stamp_expire; stamp_end } : Secmod_keys.t) =
-  let stamp_expire = Timestamp.Never in
-  let stamp_end = Timestamp.Never in
   let exchange_pub =
     (* TODO
        - I don't think its in crockford base 32 here
@@ -90,26 +85,34 @@ let mk_future_sign_key signkey_secmod_sign_f exchange_pub_key =
             to not mixup hashed values with others
        - have a make function for wrapped HashCode structs
          make it take the relevant type *)
-    let v = EddsaPublicKey.to_string exchange_pub_key in
+    let v = EddsaPublicKey.to_string pub in
     Binary_formats.ExchangePublicKeyP.{ v= { v } }
   in
-  let anchor_time = Binary_formats.TimeAbsoluteNBO.{ v= 0_L } in
-  let duration = Binary_formats.TimeRelativeNBO.{ v= 0_L } in
   let signing_key_announcement_ps =
+    let anchor_time =
+      Binary_formats.TimeAbsoluteNBO.{ v= Util.ptime_to_int64_us stamp_start }
+    in
+    let duration =
+      let v =
+        Ptime.diff stamp_start stamp_expire
+        |> Util.ptime_of_span_exn
+        |> Util.ptime_to_int64_us
+      in
+      Binary_formats.TimeRelativeNBO.{ v }
+    in
     Binary_formats.SigningKeyAnnouncementPS.
       { exchange_pub; anchor_time; duration }
   in
   let signkey_secmod_sig = signkey_secmod_sign_f signing_key_announcement_ps in
   FutureSignKey.
     {
-      key= exchange_pub_key;
+      key= pub;
-      stamp_start;
+      stamp_start= Timestamp.of_ptime stamp_start;
-      stamp_expire;
+      stamp_expire= Timestamp.of_ptime stamp_expire;
-      stamp_end;
+      stamp_end= Timestamp.of_ptime stamp_end;
       signkey_secmod_sig;
     }
 
-(* TODO *)
 let keys req _server _env =
   let open Vif.Response in
   let open Syntax in

src/secmod_denom.ml

@@ -1,5 +1,14 @@
-type rsa = {
+type rsa_denom = {
-  coin: Types.Config_types.Coin.t;
+  section_name: string;
+  value: Amount.t;
+  stamp_start: Ptime.t;
+  stamp_expire_withdraw: Ptime.t;
+  stamp_expire_deposit: Ptime.t;
+  stamp_expire_legal: Ptime.t;
+  fee_withdraw: Amount.t;
+  fee_deposit: Amount.t;
+  fee_refresh: Amount.t;
+  fee_refund: Amount.t;
   pub: Types.RsaPublicKey.t;
   sign:
     (* TODO sig type
@@ -12,18 +21,54 @@ type rsa = {
 
 let hash_pub _pub = "todo public key converted to Crockford Base32"
 
-let make_rsa (coin : Types.Config_types.Coin.t) =
+let make_rsa_denom
-  assert (coin.cipher = `RSA);
+    ({
-  assert (Option.is_some coin.rsa_keysize);
+       section_name;
-  let rsa_keysize = coin.rsa_keysize |> Option.get in
+       value;
+       duration_withdraw;
+       duration_spend;
+       duration_legal;
+       fee_withdraw;
+       fee_deposit;
+       fee_refresh;
+       fee_refund;
+       cipher;
+       rsa_keysize;
+       age_restricted= _;
+     } :
+      Types.Config_types.Coin.t) =
+  assert (cipher = `RSA);
+
+  let stamp_start = Ptime_clock.now () in
+  let stamp_expire_withdraw =
+    Util.ptime_add_span_exn stamp_start duration_withdraw
+  in
+  let stamp_expire_deposit =
+    Util.ptime_add_span_exn stamp_start duration_spend
+  in
+  let stamp_expire_legal = Util.ptime_add_span_exn stamp_start duration_legal in
+
   let open Mirage_crypto_pk.Rsa in
   let priv = generate ~bits:rsa_keysize () in
   let pub = pub_of_priv priv in
   let sign = decrypt ~crt_hardening:true ~mask:`Yes ~key:priv in
-  { coin; pub; sign }
+  {
+    section_name;
+    value;
+    stamp_start;
+    stamp_expire_withdraw;
+    stamp_expire_deposit;
+    stamp_expire_legal;
+    fee_withdraw;
+    fee_deposit;
+    fee_refresh;
+    fee_refund;
+    pub;
+    sign;
+  }
 
 let denom_device =
   let finally _key = () in
   Vif.Device.v ~name:"rsa_denom" ~finally [] @@ fun () ->
-  let rsa_l = List.map make_rsa Config.coins in
+  let rsa_l = List.map make_rsa_denom Config.coins in
   rsa_l

src/secmod_keys.ml

@@ -7,6 +7,9 @@ type t = {
        + b32 *)
     string ->
     string;
+  stamp_start: Ptime.t;
+  stamp_expire: Ptime.t;
+  stamp_end: Ptime.t;
 }
 
 let make ~name =
@@ -16,8 +19,24 @@ let make ~name =
        - look if it exists
        - if not, create it (TOFU initialization scheme)
        - write it *)
+  (* TODO time
+     correctly set those: *)
+  let stamp_start = Ptime_clock.now () in
+  let stamp_expire =
+    match Ptime.add_span stamp_start Config.Exchange.signkey_legal_duration with
+    | None ->
+        Fmt.failwith "Ptime.add_span: result is not in the range [min;max]"
+    | Some v -> v
+  in
+  let stamp_end = stamp_expire in
   let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
-  { pub; sign= Mirage_crypto_ec.Ed25519.sign ~key:priv }
+  {
+    pub;
+    sign= Mirage_crypto_ec.Ed25519.sign ~key:priv;
+    stamp_start;
+    stamp_expire;
+    stamp_end;
+  }
 
 let signkey_device = make ~name:"signkey"
 

src/types.ml

@@ -16,15 +16,15 @@ module Config_types = struct
       (* section_name: Name in the configuration file that defines this denomination *)
       section_name: string;
       value: Amount.t;
-      duration_withdraw: int;
+      duration_withdraw: Ptime.Span.t;
-      duration_spend: int;
+      duration_spend: Ptime.Span.t;
-      duration_legal: int;
+      duration_legal: Ptime.Span.t;
       fee_withdraw: Amount.t;
       fee_deposit: Amount.t;
       fee_refresh: Amount.t;
       fee_refund: Amount.t;
       cipher: [ (* `CS |*) `RSA ];
-      rsa_keysize: int option (*only if `RSA *);
+      rsa_keysize: int; (* : int option (only if `RSA) *)
       age_restricted: [ (*`YES|*) `NO ];
     }
   end
@@ -43,20 +43,21 @@ end
 (* TODO number
    - number is "float", but we probably want int everywhere instead
    - numeric values capped at 2^53 -1 inclusive because json
-   - have a type for seconds/microseconds/..? *)
+   *)
+
+(* TODO time
+   - int64 instead of float/int (binary format time in int64 us)
+   ? make api types take in Ptime.t instead of Timestamp.t
+   ? issues with "never" = uint64_max *)
 module Timestamp = struct
-  (* Seconds since epoch, or the special
-     value "never" to represent an event that will
-     never happen. *)
   type t =
     | Seconds of float
     | Never
+
+  let of_ptime p = Seconds (Ptime.to_float_s p)
 end
 
 module RelativeTime = struct
-  (* Duration in microseconds or "forever"
-     to represent an infinite duration. Numeric
-     values are capped at 2^53 - 1 inclusive. *)
   type t =
     | Microseconds of float
     | Forever

src/util.ml

@@ -1,8 +1,22 @@
-(* TODO *)
 module Protocol_version = struct
+  (* TODO *)
   (* libtool version format *)
   let current = 0
   let revision = 0
   let age = 0
   let v = Fmt.str "%d:%d:%d"
 end
+
+(* -- Ptime -- *)
+
+let ptime_to_int64_us p = Int64.of_float (1_000_000. *. Ptime.to_float_s p)
+
+let ptime_of_span_exn span =
+  match Ptime.of_span span with
+  | None -> Fmt.failwith "Ptime.of_span: not in the range [min;max]"
+  | Some p -> p
+
+let ptime_add_span_exn p span =
+  match Ptime.add_span p span with
+  | None -> Fmt.failwith "Ptime.add_span: not in the range [min;max]"
+  | Some v -> v