JJ: Description from the destination commit:

fix secmod add/write; + wip test revoke

JJ: Description from source commit:
+ test disable-auditor + wire + drain

src/api.ml

@@ -624,44 +624,6 @@ module GlobalFees = struct
     |> finish
 end
 
-module WireSetupMessage = struct
-  type t = {
-    payto_uri: string;
-    master_sig_wire: MasterWireDetails.t;
-    master_sig_add: MasterAddWire.t;
-    validity_start: Timestamp.t;
-    bank_label: string option;
-    priority: int option;
-  }
-
-  let jsont =
-    let make payto_uri master_sig_wire master_sig_add validity_start bank_label
-        priority =
-      {
-        payto_uri;
-        master_sig_wire;
-        master_sig_add;
-        validity_start;
-        bank_label;
-        priority;
-      }
-    in
-    let payto_uri v = v.payto_uri in
-    let master_sig_wire v = v.master_sig_wire in
-    let master_sig_add v = v.master_sig_add in
-    let validity_start v = v.validity_start in
-    let bank_label v = v.bank_label in
-    let priority v = v.priority in
-    map ~kind:"WireSetupMessage" make
-    |> mem "payto_uri" Jsont.string ~enc:payto_uri
-    |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
-    |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
-    |> mem "validity_start" Timestamp.jsont ~enc:validity_start
-    |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
-    |> mem "priority" (Jsont.option Jsont.int) ~enc:priority
-    |> finish
-end
-
 module WireTeardownMessage = struct
   type t = {
     payto_uri: string;
@@ -685,7 +647,7 @@ end
 
 module DrainProfitsMessage = struct
   type t = {
-    wtid: B32.t;
+    wtid: Bytes32.t;
     debit_account_section: string;
     credit_payto_uri: string;
     date: Timestamp.t;
@@ -1137,6 +1099,61 @@ module AccountRestriction = struct
     |> finish
 end
 
+module WireSetupMessage = struct
+  type t = {
+    payto_uri: string;
+    master_sig_wire: MasterWireDetails.t;
+    master_sig_add: MasterAddWire.t;
+    conversion_url: string option;
+    credit_restrictions: AccountRestriction.t list;
+    debit_restrictions: AccountRestriction.t list;
+    validity_start: Timestamp.t;
+    bank_label: string option;
+    priority: int option;
+  }
+
+  let jsont =
+    let make payto_uri master_sig_wire master_sig_add conversion_url
+        credit_restrictions debit_restrictions validity_start bank_label
+        priority =
+      {
+        payto_uri;
+        master_sig_wire;
+        master_sig_add;
+        conversion_url;
+        credit_restrictions;
+        debit_restrictions;
+        validity_start;
+        bank_label;
+        priority;
+      }
+    in
+    let payto_uri v = v.payto_uri in
+    let master_sig_wire v = v.master_sig_wire in
+    let master_sig_add v = v.master_sig_add in
+    let conversion_url v = v.conversion_url in
+    let credit_restrictions v = v.credit_restrictions in
+    let debit_restrictions v = v.debit_restrictions in
+    let validity_start v = v.validity_start in
+    let bank_label v = v.bank_label in
+    let priority v = v.priority in
+    map ~kind:"WireSetupMessage" make
+    |> mem "payto_uri" Jsont.string ~enc:payto_uri
+    |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
+    |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
+    |> mem "conversion_url" (Jsont.option Jsont.string) ~enc:conversion_url
+    |> mem "credit_restrictions"
+         (Jsont.list AccountRestriction.jsont)
+         ~enc:credit_restrictions
+    |> mem "debit_restrictions"
+         (Jsont.list AccountRestriction.jsont)
+         ~enc:debit_restrictions
+    |> mem "validity_start" Timestamp.jsont ~enc:validity_start
+    |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
+    |> mem "priority" (Jsont.option Jsont.int) ~enc:priority
+    |> finish
+end
+
 module ExchangeWireAccount = struct
   type t = {
     payto_uri: string;

src/auditor.ml

@@ -0,0 +1,19 @@
+type t = {
+  auditor_pub: Crypto.EddsaPublicKey.t;
+  auditor_url: string;
+  auditor_name: string;
+  last_change: Timestamp.t;
+  is_active: bool;
+}
+
+let of_setup_message
+    Api.AuditorSetupMessage.
+      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
+    =
+  {
+    auditor_url;
+    auditor_name;
+    auditor_pub;
+    last_change= validity_start;
+    is_active= true;
+  }

src/http_management.ml

@@ -9,7 +9,7 @@ module Keys_get = struct
     Logs.info (fun m -> m "GET /management/keys/");
     let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
     let res =
-      let v = Keys.make_future_keys_response () in
+      let* v = Keys.make_future_keys_response () in
       Api.encode jsont v
     in
     Respond.result res req
@@ -153,24 +153,22 @@ module Auditors = struct
         h_auditor_url= Hash.Cstring.H64.hash auditor_url;
       }
 
-  (* TODO monotonic time *)
   let do_ ~db_conn v =
     let auditor_pub = v.AuditorSetupMessage.auditor_pub in
     let validity_start = v.AuditorSetupMessage.validity_start in
-    let* last_date_opt =
+    let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
-      Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+    match opt with
-    in
-    match last_date_opt with
     | None ->
-        let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
+        let auditor = Auditor.of_setup_message v in
+        let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
         Logs.info (fun m -> m "enabled auditor");
         ()
-    | Some last_date ->
+    | Some auditor ->
-        if Timestamp.compare last_date validity_start > 0 then
+        if Timestamp.compare auditor.last_change validity_start > 0 then
           Error
             "database has more recent auditor data for this auditor public key"
         else
-          let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
+          let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
           Logs.info (fun m -> m "updated auditor");
           ()
 
@@ -198,26 +196,36 @@ module Auditors_disable = struct
 
   let do_ ~db_conn auditor_pub
       AuditorTeardownMessage.{ master_sig= _; validity_end } =
-    let* last_date_opt =
+    let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
-      Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+    match opt with
-    in
-    match last_date_opt with
     | None -> Error "auditor not found"
-    | Some last_date ->
+    | Some auditor -> (
-        if Timestamp.compare last_date validity_end > 0 then
+        match Timestamp.compare auditor.last_change validity_end > 0 with
+        | true ->
             Error
-            "database has more recent auditor data for this auditor public key"
+              "database has more recent auditor data for this auditor public \
-        else
+               key"
-          let+ () =
+        | false -> (
-            Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
+            match auditor.is_active with
-            |> unwrap_err_caqti
+            | false ->
+                Logs.info (fun m -> m "auditor was already revoked");
+                Ok ()
+            | true ->
+                let auditor =
+                  { auditor with last_change= validity_end; is_active= false }
                 in
-          ()
+                let+ () =
+                  Pg.update_auditor db_conn auditor |> unwrap_err_caqti
+                in
+                Logs.info (fun m ->
+                    m "revoked auditor `%s`"
+                      (Crypto.EddsaPublicKey.to_b32 auditor_pub));
+                ()))
 
   let jsont = AuditorTeardownMessage.jsont
 
   let f req auditor_pub server _env =
-    Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
+    Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/");
     let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
@@ -367,22 +375,37 @@ module Wire = struct
           payto_uri;
           master_sig_wire;
           master_sig_add;
+          conversion_url;
+          credit_restrictions;
+          debit_restrictions;
           validity_start;
           bank_label= _;
           priority= _;
         } =
-    (* TODO are those read from payto_uri? *)
+    (* TODO wire
-    let conversion_url = "" in
+       hash over json, hash over string option? *)
-    let credit_restrictions = "" in
+    let* () =
-    let debit_restrictions = "" in
+      match (credit_restrictions, debit_restrictions) with
+      | [], [] -> Ok ()
+      | _ ->
+          Fmt.error
+            "wire setup: credit_restrictions and debit_restrictions are not \
+             supported"
+    in
+    let h_wire_details = Hash.FullPaytoHash.hash payto_uri in
+    let h_conversion_url =
+      Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url)
+    in
+    let h_credit_restrictions = Hash.Cstring.H64.hash "" in
+    let h_debit_restrictions = Hash.Cstring.H64.hash "" in
     let* () =
       let open Signatures.MasterWireDetails in
       verify Config.master_public_key master_sig_wire
         {
-          h_wire_details= FullPaytoHash.hash payto_uri;
+          h_wire_details;
-          h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+          h_conversion_url;
-          h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+          h_credit_restrictions;
-          h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+          h_debit_restrictions;
         }
     in
     let* () =
@@ -390,38 +413,56 @@ module Wire = struct
       verify Config.master_public_key master_sig_add
         {
           start_date= validity_start;
-          h_wire= FullPaytoHash.hash payto_uri;
+          h_wire= h_wire_details;
-          h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+          h_conversion_url;
-          h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+          h_credit_restrictions;
-          h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+          h_debit_restrictions;
         }
     in
     Ok ()
 
-  let do_ ~db_conn v =
+  let do_ ~db_conn
-    let* last_change_opt =
+      WireSetupMessage.
-      let payto_uri = v.WireSetupMessage.payto_uri in
+        {
-      Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+          payto_uri;
+          master_sig_wire;
+          master_sig_add= _;
+          conversion_url;
+          credit_restrictions;
+          debit_restrictions;
+          validity_start;
+          bank_label;
+          priority;
+        } =
+    let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
+    match opt with
+    | Some wire ->
+        let+ () =
+          Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
+            wire
+          |> unwrap_err_caqti
         in
-    match last_change_opt with
+        Logs.info (fun m -> m "updated wire method");
-    | Some _ -> Error "wire already setup"
+        ()
     | None ->
-        let r =
+        let wire =
           ExchangeWireAccount.
             {
-              payto_uri= v.payto_uri;
+              payto_uri;
-              conversion_url= None;
+              conversion_url;
-              debit_restrictions= [];
+              credit_restrictions;
-              credit_restrictions= [];
+              debit_restrictions;
-              master_sig= v.master_sig_wire;
+              master_sig= master_sig_wire;
-              bank_label= v.bank_label;
+              bank_label;
-              priority= v.priority;
+              priority;
             }
         in
         let+ () =
-          Pg.insert_wire db_conn ~last_change:v.validity_start r
+          Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
+            wire
           |> unwrap_err_caqti
         in
+        Logs.info (fun m -> m "added wire method");
         ()
 
   let jsont = WireSetupMessage.jsont
@@ -448,15 +489,15 @@ module Wire_disable = struct
 
   let do_ ~db_conn
       WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
-    let* last_change_opt =
+    let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
-      Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+    match opt with
-    in
-    match last_change_opt with
     | None -> Error "wire not found"
-    | Some _ ->
+    | Some wire ->
         let+ () =
-          Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
+          Pg.update_wire db_conn ~is_active:false ~last_change:validity_end wire
+          |> unwrap_err_caqti
         in
+        Logs.info (fun m -> m "disabled wire method");
         ()
 
   let jsont = WireTeardownMessage.jsont
@@ -496,7 +537,17 @@ module Drain = struct
       }
 
   let do_ ~db_conn v =
+    let* opt =
+      Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid
+      |> unwrap_err_caqti
+    in
+    match opt with
+    | Some _ ->
+        Logs.info (fun m -> m "drain profit message already added to database");
+        Ok ()
+    | None ->
         let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
+        Logs.info (fun m -> m "added drain profit message to database");
         ()
 
   let jsont = DrainProfitsMessage.jsont

src/keys.ml

@@ -13,7 +13,7 @@ module type S = sig
   val denominations : unit -> Denomination.t list result
   val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
   val find_future_denomination : denom_hash -> Api.FutureDenom.t result
-  val make_future_keys_response : unit -> Api.FutureKeysResponse.t
+  val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
 
   val certify_future_signkey :
     eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@@ -68,6 +68,7 @@ module Make (Conn : Pg.CONN) : S = struct
             m
               "some signkeys found in database are missing from secmod, \
                (unclean database/secmod state?)");
+        Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
         l
 
   let denominations () =
@@ -84,9 +85,12 @@ module Make (Conn : Pg.CONN) : S = struct
             m
               "some denominations found in database are missing from secmod, \
                (unclean database/secmod state?)");
+        Logs.debug (fun m ->
+            m "found %d active denomination(s)" (List.length l));
         l
 
   let make_future_sk (pub, (start, expire)) =
+    Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
     let open Time in
     let stamp_start = Timestamp.of_absolute start in
     let stamp_expire = Timestamp.of_absolute expire in
@@ -113,6 +117,9 @@ module Make (Conn : Pg.CONN) : S = struct
     | Some v -> v
 
   let make_future_dn (h_pub, (section_name, pub, start)) =
+    Logs.debug (fun m ->
+        m "make_future_dn: `%s`"
+          (B32.encode @@ Hash.DenominationHash.to_octets h_pub));
     let open Time in
     let Config.Coin.
           {
@@ -187,8 +194,29 @@ module Make (Conn : Pg.CONN) : S = struct
         Ok future_dn
 
   let make_future_keys_response () =
-    let future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
+    let now = Timestamp.of_ptime @@ Ptime_clock.now () in
-    let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
+    (* get keys from database to filter out keys already certified *)
+    let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
+    let sk_ht = Hashtbl.create 0xff in
+    List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
+    let future_signkeys =
+      Sm_eddsa.keys ()
+      |> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
+      |> List.map make_future_sk
+    in
+    let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in
+    let dn_ht = Hashtbl.create 0xff in
+    List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
+    let future_denoms =
+      Sm_rsa.keys ()
+      |> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
+      |> List.map make_future_dn
+    in
+    Logs.info (fun m ->
+        m "%d future signkey(s) and %d future denomination(s) to certify"
+          (List.length future_signkeys)
+          (List.length future_denoms));
+    Ok
       Api.FutureKeysResponse.
         {
           future_denoms;
@@ -257,8 +285,10 @@ module Make (Conn : Pg.CONN) : S = struct
             (* rebuild it *)
             let future_sk = make_future_sk (pub, (t1, t2)) in
             let sk = sk_of_future_sk future_sk master_sig in
-            let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
+            let+ () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
-            Ok ())
+            Logs.info (fun m ->
+                m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
+            ())
 
   let certify_future_denomination h_pub master_sig =
     match Sm_rsa.find_key h_pub with
@@ -272,8 +302,11 @@ module Make (Conn : Pg.CONN) : S = struct
         | None ->
             let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
             let dn = dn_of_future_dn future_dn h_pub master_sig in
-            let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
+            let+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in
-            Ok ())
+            Logs.info (fun m ->
+                m "certified denomination `%s`"
+                  (B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
+            ())
 
   let revoke_signkey pub revoked_sig =
     let* opt = find_signkey pub in
@@ -282,6 +315,7 @@ module Make (Conn : Pg.CONN) : S = struct
     let+ () =
       Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
     in
+    Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
     ()
 
   let revoke_denomination h_pub revoked_sig =
@@ -292,5 +326,8 @@ module Make (Conn : Pg.CONN) : S = struct
       Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
       |> unwrap_err_caqti
     in
+    Logs.info (fun m ->
+        m "revoked denomination `%s`"
+          (B32.encode @@ Hash.DenominationHash.to_octets h_pub));
     ()
 end

src/pg.ml

@@ -115,43 +115,23 @@ let insert_signkey_revocation =
   fun (module Conn : CONN) exchange_pub master_sig ->
     Conn.exec req (exchange_pub, master_sig)
 
-let get_auditor_timestamp =
+let find_auditor =
   let req =
-    Caqti_type.(eddsa_pub ->? time)
+    Caqti_type.(eddsa_pub ->? auditor)
-      "SELECT last_change FROM auditors WHERE auditor_pub=$1"
+      "SELECT auditor_pub, auditor_name, auditor_url, last_change, is_active \
+       FROM auditors WHERE auditor_pub=$1"
   in
   fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub
 
-let insert_auditor =
-  let req =
-    Caqti_type.(t4 eddsa_pub string string time ->. unit)
-      "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
-       is_active, last_change) VALUES ($1, $2, $3, true, $4)"
-  in
-  fun (module Conn : CONN)
-    AuditorSetupMessage.
-      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-  -> Conn.exec req (auditor_pub, auditor_name, auditor_url, validity_start)
-
 let update_auditor =
   let req =
-    Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
+    Caqti_type.(auditor ->. unit)
-      "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
+      "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
-       last_change=$5 WHERE auditor_pub=$1"
+       last_change, is_active) VALUES ($1, $2, $3, $4, $5) ON CONFLICT \
+       (auditor_pub) DO UPDATE SET auditor_name=$2, auditor_url=$3, \
+       last_change=$4, is_active=$5"
   in
-  fun (module Conn : CONN)
+  fun (module Conn : CONN) auditor -> Conn.exec req auditor
-    AuditorSetupMessage.
-      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-  -> Conn.exec req (auditor_pub, auditor_url, auditor_name, true, validity_start)
-
-let disable_auditor =
-  let req =
-    Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
-      "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
-       last_change=$5 WHERE auditor_pub=$1"
-  in
-  fun (module Conn : CONN) ~auditor_pub ~change_date ->
-    Conn.exec req (auditor_pub, "", "", false, change_date)
 
 let insert_auditor_denom_sig =
   let req =
@@ -167,6 +147,7 @@ let insert_auditor_denom_sig =
     Conn.exec req (auditor_pub, h_denom_pub, auditor_sig)
 
 (* todo auditors
+   map to Auditor.t record
    maybe check that url and name are unique/same for each auditor_pub
    and do the ht logic out of pg.ml? *)
 (* this does not return auditors that are not auditing any denom *)
@@ -274,46 +255,30 @@ let insert_global_fees =
   in
   fun (module Conn : CONN) v -> Conn.exec req v
 
-let get_wire_timestamp =
+let find_wire =
   let req =
-    Caqti_type.(payto_uri ->? time)
+    Caqti_type.(payto_uri ->? exchange_wire_account)
-      "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
+      "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
+       credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
+       wire_accounts WHERE payto_uri=$1"
   in
   fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri
 
-let insert_wire =
+let update_wire =
   let req =
     Caqti_type.(t3 exchange_wire_account bool time ->. unit)
       "INSERT INTO wire_accounts (payto_uri, conversion_url, \
        credit_restrictions, debit_restrictions, master_sig, bank_label, \
        priority, is_active, last_change) VALUES \
-       ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
+       ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,$8,$9) ON CONFLICT \
-  in
+       (payto_uri) DO UPDATE SET conversion_url=$2, \
-  fun (module Conn : CONN) ~last_change v ->
+       credit_restrictions=$3::TEXT::JSONB, \
-    let is_active = true in
+       debit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
-    Conn.exec req (v, is_active, last_change)
+       priority=$7, is_active=$8, last_change=$9"
-
-let update_wire =
-  let req =
-    Caqti_type.(t3 exchange_wire_account bool time ->. unit)
-      "UPDATE wire_accounts SET conversion_url=$2, \
-       debit_restrictions=$3::TEXT::JSONB, \
-       credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
-       priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
   in
   fun (module Conn : CONN) ~is_active ~last_change v ->
     Conn.exec req (v, is_active, last_change)
 
-let disable_wire =
-  let req =
-    Caqti_type.(t2 payto_uri time ->. unit)
-      "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
-       credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
-       priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
-  in
-  fun (module Conn : CONN) ~payto_uri ~validity_end ->
-    Conn.exec req (payto_uri, validity_end)
-
 let get_wire_accounts =
   let req =
     Caqti_type.(unit ->* exchange_wire_account)
@@ -323,11 +288,20 @@ let get_wire_accounts =
   in
   fun (module Conn : CONN) () -> Conn.collect_list req ()
 
+let find_drain_profit =
+  let req =
+    Caqti_type.(octets ->? drain_profit_message)
+      "SELECT wtid, account_section, payto_uri, trigger_date, (amount).*, \
+       master_sig FROM profit_drains WHERE wtid=$1"
+  in
+  fun (module Conn : CONN) wtid -> Conn.find_opt req wtid
+
 let insert_drain_profit =
   let req =
     Caqti_type.(drain_profit_message ->. unit)
       "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
-       trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
+       trigger_date, amount, master_sig) VALUES ($1::BYTEA, $2, $3, $4, \
+       ($5,$6), $7)"
   in
   fun (module Conn : CONN) v -> Conn.exec req v
 

src/pg_type.ml

@@ -24,7 +24,6 @@ let eddsa_sig = EddsaSignature.caqti
 (* todo: enum type for wire_method? *)
 let wire_method = Caqti_type.string
 let payto_uri = Caqti_type.string
-let b32 = B32.caqti
 
 include struct
   (* alias for hash *)
@@ -266,7 +265,7 @@ let drain_profit_message =
           amount;
           master_sig;
         })
-    Caqti_type.(t6 b32 string string time amount master_sig)
+    Caqti_type.(t6 octets string string time amount master_sig)
 
 let aml_officer_setup =
   let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
@@ -351,3 +350,14 @@ let exchange_partner_setup =
           wad_fee;
         })
     Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
+
+let auditor =
+  let open Auditor in
+  Caqti_type.custom
+    ~encode:(fun
+        { auditor_pub; auditor_url; auditor_name; last_change; is_active } ->
+      Ok (auditor_pub, auditor_url, auditor_name, last_change, is_active))
+    ~decode:(fun
+        (auditor_pub, auditor_url, auditor_name, last_change, is_active) ->
+      Ok { auditor_pub; auditor_url; auditor_name; last_change; is_active })
+    Caqti_type.(t5 eddsa_pub string string time bool)

src/secmod_eddsa.ml

@@ -57,11 +57,17 @@ let write_eddsa fpath priv =
 let write_key k = write_eddsa (key_fpath k) k.priv
 
 let delete_file fpath =
-  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* check fpath just to be safe *)
-  (* TODO just to be safe~~
+  let () =
+    let root = Fpath.v Cfg.key_dir in
+    if not @@ Fpath.is_rooted ~root fpath then
+      Fmt.failwith
+        "delete_file failure: file `%a` is not contained in secmod directory"
+        Fpath.pp fpath
+  in
+  Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
   let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
-*)
+  ()
-  Ok ()
 
 let get_key_dir_contents dir =
   let* dir = Fpath.of_string dir |> unwrap_err_msg in
@@ -70,7 +76,7 @@ let get_key_dir_contents dir =
   let+ l =
     Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
   in
-  l
+  List.map Fpath.normalize l
 
 (* -- *)
 
@@ -131,11 +137,7 @@ let load_key fpath =
 
 let load () =
   let* l = get_key_dir_contents Cfg.key_dir in
-  let l =
+  let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
-    l
-    |> List.map Fpath.normalize
-    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
-  in
   let* keys = list_map load_key l in
   match keys with
   | [] -> Ok None
@@ -162,7 +164,7 @@ let init () =
   let now = TimeAbsolute.of_ptime (Ptime_clock.now ()) in
   let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
   let new_keys = gen_additional_keys_until_lookahead ~now keys in
-  let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in
+  List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys;
   let+ () = list_iter write_key new_keys in
   t
 
@@ -178,6 +180,7 @@ module Make () = struct
   let add t1 t2 =
     let k = gen_key t1 t2 in
     Hashtbl.replace t.ht k.pub k;
+    let+ () = write_key k in
     ()
 
   let delete pub =
@@ -206,7 +209,8 @@ module Make () = struct
   let revoke pub =
     let* k = find pub in
     let* () = delete pub in
-    add k.t1 k.t2; Ok ()
+    let* () = add k.t1 k.t2 in
+    Ok ()
 
   let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
   let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv

src/secmod_rsa.ml

@@ -100,11 +100,17 @@ let write_rsa fpath priv =
 let write_key k = write_rsa (key_fpath k) k.priv
 
 let delete_file fpath =
-  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* check fpath just to be safe *)
-  (* TODO just to be safe~~
+  let () =
+    let root = Fpath.v Cfg.key_dir in
+    if not @@ Fpath.is_rooted ~root fpath then
+      Fmt.failwith
+        "delete_file failure: file `%a` is not contained in secmod directory"
+        Fpath.pp fpath
+  in
+  Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
   let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
-*)
+  ()
-  Ok ()
 
 let get_key_dir_contents dir_fpath =
   let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
@@ -112,7 +118,7 @@ let get_key_dir_contents dir_fpath =
   let+ l =
     Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
   in
-  l
+  List.map Fpath.normalize l
 
 (* -- *)
 
@@ -179,11 +185,7 @@ let load_key ~section_name fpath =
 let load_section section_name =
   let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
   let* l = get_key_dir_contents section_fpath in
-  let l =
+  let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
-    l
-    |> List.map Fpath.normalize
-    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
-  in
   let* keys = list_map (load_key ~section_name) l in
   Ok keys
 
@@ -224,7 +226,7 @@ let init () =
       Cfg.sections
   in
   let new_keys = List.concat new_keys_l in
-  let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in
+  List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
   let+ () = list_iter write_key new_keys in
   t
 
@@ -252,6 +254,7 @@ module Make () = struct
   let add section_name t1 t2 =
     let k = gen_key ~section_name t1 t2 in
     Hashtbl.replace t.ht k.h_pub k;
+    let+ () = write_key k in
     ()
 
   let sm_pub = t.sm_pub
@@ -263,9 +266,11 @@ module Make () = struct
     data
 
   let revoke h_pub =
+    Log.debug (fun m ->
+        m "revoke `%s`" (DenominationHash.to_octets h_pub |> B32.encode));
     let* k = find h_pub in
     let* () = delete h_pub in
-    add k.section_name k.t1 k.t2;
+    let* () = add k.section_name k.t1 k.t2 in
     Ok ()
 
   let conv =

src/util.ml

@@ -48,8 +48,13 @@ module Log_reporter = struct
     in
     { report }
 
+  let set_level_secmods lvl =
+    let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
+    List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
+    ()
+
   let setup () =
-    (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*)
+    (*set_level_secmods (Some Logs.Debug);*)
     let level = Some Logs.Info in
     Logs.set_level ~all:false level;
     Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();

test/offline_management.sh

@@ -22,16 +22,41 @@ offline_tool sign \
 offline_tool upload --input $b --url $url"/management/keys"
 echo "[OK] /management/keys"
 
+offline_tool download --output $a --url $url"/keys"
+rsa_pub=$(jq -r '.denominations[0].denoms[0].rsa_pub' $a)
+offline_tool revoke-denom \
+--master_key $master_key \
+--output $b \
+--rsa \
+$rsa_pub
+h_denom=$(dune exec offline -- hash64 $rsa_pub)
+offline_tool upload --input $b --url $url"/management/denominations/"$h_denom"/revoke"
+echo "[OK] /management/denominations/\$H_DENOM/revoke"
+
+pub=$(jq -r '.signkeys[0].key' $a)
+offline_tool revoke-signkey \
+--master_key $master_key \
+--output $b \
+$pub
+offline_tool upload --input $b --url $url"/management/signkeys/"$pub"/revoke"
+echo "[OK] /management/signkeys/\$EXCHANGE_PUB/revoke"
+
 offline_tool enable-auditor \
 --master_key $master_key \
 --output $b \
 --auditor_url "auditor.example.com" \
 --auditor_name "auditor example" \
---auditor_pub $auditor_pub \
+--auditor_pub $auditor_pub
---validity_start 0
 offline_tool upload --input $b --url $url"/management/auditors"
 echo "[OK] /management/auditors"
 
+offline_tool disable-auditor \
+--master_key $master_key \
+--output $b \
+--auditor_pub $auditor_pub
+offline_tool upload --input $b --url $url"/management/auditors/"$auditor_pub"/disable"
+echo "[OK] /management/auditors/\$AUDITOR_PUB/disable"
+
 offline_tool wire-fee \
 --master_key $master_key \
 --output $b \
@@ -56,3 +81,32 @@ offline_tool global-fees \
 --purse_timeout 9999999
 offline_tool upload --input $b --url $url"/management/global-fees"
 echo "[OK] /management/global-fees"
+
+offline_tool enable-wire \
+--master_key $master_key \
+--output $b \
+--payto_uri "" \
+--bank_label "" \
+--priority 4
+offline_tool upload --input $b --url $url"/management/wire"
+echo "[OK] /management/wire"
+
+offline_tool disable-wire \
+--master_key $master_key \
+--output $b \
+--payto_uri ""
+offline_tool upload --input $b --url $url"/management/wire/disable"
+echo "[OK] /management/wire/disable"
+
+# wtid (after base32 decode) must be 32bytes
+wtid="000G40R40M30E209185GR38E1W8124GK2GAHC5RR34D1P70X3RFG"
+offline_tool drain \
+--master_key $master_key \
+--output $b \
+--debit_account_section "" \
+--credit_payto_uri "" \
+--wtid $wtid \
+--date 0 \
+--amount $zero_euro
+offline_tool upload --input $b --url $url"/management/drain"
+echo "[OK] /management/drain"

tools/dune

@@ -2,7 +2,7 @@
  (public_name offline)
  (name offline)
  (modules offline offline_impl)
- (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
+ (libraries cmdliner bos fmt mirage-crypto mtime ptime mte vif))
 
 (executable
  (public_name gen_registry_files)

tools/offline.ml

@@ -1,13 +1,6 @@
-(* TODO
+(* not done:
-   all management operations:
+  /management/aml-officers (for /aml)
-     /management/wire
+  /management/partners (for /wads) *)
-     /management/wire/disable
-
-     /management/aml-officers
-       -> /aml
-     /management/partners
-       -> /wads *)
-
 open Cmdliner
 open Cmdliner.Term.Syntax
 open Offline_impl
@@ -128,14 +121,54 @@ let sign_cmd =
 
 let revoke_denom_cmd =
   let doc = "Revoke denomination." in
-  let h_denom =
+  let is_rsa_pub =
-    let doc = "hash of denomination public key" in
+    let doc =
+      "interpret input string as a RSA public key (in Crockford-base32) \
+       instead of a denomination hash"
+    in
+    Arg.(value & flag & info [ "rsa" ] ~doc)
+  in
+  let v =
+    let doc = "hash of denomination (or RSA public key if --rsa is set)" in
     Arg.(required & pos 0 (some string) None & info [] ~doc)
   in
   Cmd.make (Cmd.info "revoke-denom" ~doc)
   @@
-  let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
+  let+ output = output
-  revoke_denom ~output ~master_key ~h_denom
+  and+ master_key = master_key
+  and+ is_rsa_pub = is_rsa_pub
+  and+ v = v in
+  let res =
+    match is_rsa_pub with
+    | false -> Ok v
+    | true -> (
+        match B32.decode v with
+        | Error e -> Error e
+        | Ok s ->
+            let h = Hash.DenominationHash.hash s in
+            let s = B32.encode (Hash.DenominationHash.to_octets h) in
+            Ok s)
+  in
+  match res with
+  | Error e -> Error e
+  | Ok h_denom -> revoke_denom ~output ~master_key ~h_denom
+
+(* just for tests... *)
+let test_hash64_cmd =
+  let doc =
+    "Compute SHA-512, print output to stdout, input and output are \
+     Crockford-base32 encoded"
+  in
+  let s = Arg.(required & pos 0 (some string) None & info []) in
+  Cmd.make (Cmd.info "hash64" ~doc)
+  @@
+  let+ s = s in
+  match B32.decode s with
+  | Error e -> Error e
+  | Ok s ->
+      let h = Hash.DenominationHash.hash s in
+      let s = B32.encode (Hash.DenominationHash.to_octets h) in
+      Fmt.pr "%s@." s; Ok ()
 
 let revoke_signkey_cmd =
   let doc = "Revoke signkey." in
@@ -159,35 +192,26 @@ let enable_auditor_cmd =
   let auditor_pub =
     Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
   in
-  let validity_start =
-    Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
-  in
   Cmd.make (Cmd.info "enable-auditor" ~doc)
   @@
   let+ output = output
   and+ master_key = master_key
   and+ auditor_url = auditor_url
   and+ auditor_name = auditor_name
-  and+ auditor_pub = auditor_pub
+  and+ auditor_pub = auditor_pub in
-  and+ validity_start = validity_start in
   enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
-    ~validity_start
 
 let disable_auditor_cmd =
   let doc = "Disable auditor." in
   let auditor_pub =
     Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
   in
-  let validity_end =
-    Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
-  in
   Cmd.make (Cmd.info "disable-auditor" ~doc)
   @@
   let+ output = output
   and+ master_key = master_key
-  and+ auditor_pub = auditor_pub
+  and+ auditor_pub = auditor_pub in
-  and+ validity_end = validity_end in
+  disable_auditor ~output ~master_key ~auditor_pub
-  disable_auditor ~output ~master_key ~auditor_pub ~validity_end
 
 let wire_fee_cmd =
   let doc = "Provides wire fee configuration." in
@@ -261,6 +285,36 @@ let global_fees_cmd =
     ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
     ~purse_timeout
 
+let enable_wire_cmd =
+  let doc = "Enable wire method." in
+  let payto_uri =
+    Arg.(required & opt (some string) None & info [ "payto_uri" ])
+  in
+  let bank_label =
+    Arg.(value & opt (some string) None & info [ "bank_label" ])
+  in
+  let priority = Arg.(value & opt (some int) None & info [ "priority" ]) in
+  Cmd.make (Cmd.info "enable-wire" ~doc)
+  @@
+  let+ output = output
+  and+ master_key = master_key
+  and+ payto_uri = payto_uri
+  and+ bank_label = bank_label
+  and+ priority = priority in
+  enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority
+
+let disable_wire_cmd =
+  let doc = "Disable wire method." in
+  let payto_uri =
+    Arg.(required & opt (some string) None & info [ "payto_uri" ])
+  in
+  Cmd.make (Cmd.info "disable-wire" ~doc)
+  @@
+  let+ output = output
+  and+ master_key = master_key
+  and+ payto_uri = payto_uri in
+  disable_wire ~output ~master_key ~payto_uri
+
 let drain_cmd =
   let doc =
     "Drain profits from the exchange. The actual drain requires running the \
@@ -304,7 +358,11 @@ let cli =
       disable_auditor_cmd;
       wire_fee_cmd;
       global_fees_cmd;
+      enable_wire_cmd;
+      disable_wire_cmd;
       drain_cmd;
+      (* - *)
+      test_hash64_cmd;
     ]
 
 let main () = Cmd.eval_result cli

tools/offline_impl.ml

@@ -275,9 +275,10 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
   let* () = write_file output s in
   Ok ()
 
-let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
+let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub =
-    ~validity_start =
   let* key = read_master_key_file master_key in
+  let ns = Mtime_clock.now_ns () in
+  let validity_start = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
   let master_sig =
     let open Signatures.MasterAddAuditor in
     signf (EddsaSignature.sign ~key)
@@ -295,8 +296,10 @@ let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
   let* () = write_file output s in
   Ok ()
 
-let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
+let disable_auditor ~output ~master_key ~auditor_pub =
   let* key = read_master_key_file master_key in
+  let ns = Mtime_clock.now_ns () in
+  let validity_end = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
   let master_sig =
     let open Signatures.MasterDelAuditor in
     signf (EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
@@ -335,9 +338,84 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
   let* () = write_file output s in
   Ok ()
 
+(* TODO wire
+   hash over json, hash over string option?
+
+   ~conversion_url ~credit_restrictions ~debit_restrictions *)
+let enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority =
+  let* key = read_master_key_file master_key in
+  let ns = Mtime_clock.now_ns () in
+  let validity_start = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
+  let h_wire_details = Hash.FullPaytoHash.hash payto_uri in
+  let conversion_url = None in
+  let credit_restrictions = [] in
+  let debit_restrictions = [] in
+  let h_conversion_url =
+    Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url)
+  in
+  let h_credit_restrictions = Hash.Cstring.H64.hash "" in
+  let h_debit_restrictions = Hash.Cstring.H64.hash "" in
+  let master_sig_wire =
+    let open Signatures.MasterWireDetails in
+    signf (EddsaSignature.sign ~key)
+      {
+        h_wire_details;
+        h_conversion_url;
+        h_credit_restrictions;
+        h_debit_restrictions;
+      }
+  in
+  let master_sig_add =
+    let open Signatures.MasterAddWire in
+    signf (EddsaSignature.sign ~key)
+      {
+        start_date= validity_start;
+        h_wire= h_wire_details;
+        h_conversion_url;
+        h_credit_restrictions;
+        h_debit_restrictions;
+      }
+  in
+  let v =
+    Api.WireSetupMessage.
+      {
+        master_sig_wire;
+        master_sig_add;
+        payto_uri;
+        conversion_url;
+        credit_restrictions;
+        debit_restrictions;
+        validity_start;
+        bank_label;
+        priority;
+      }
+  in
+  let* s = Api.encode Api.WireSetupMessage.jsont v in
+  let* () = write_file output s in
+  Ok ()
+
+let disable_wire ~output ~master_key ~payto_uri =
+  let* key = read_master_key_file master_key in
+  let ns = Mtime_clock.now_ns () in
+  let validity_end = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
+  let h_wire = Hash.FullPaytoHash.hash payto_uri in
+  let master_sig_del =
+    let open Signatures.MasterDelWire in
+    signf (EddsaSignature.sign ~key) { end_date= validity_end; h_wire }
+  in
+  let v = Api.WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } in
+  let* s = Api.encode Api.WireTeardownMessage.jsont v in
+  let* () = write_file output s in
+  Ok ()
+
 let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
     ~date ~amount =
   let* key = read_master_key_file master_key in
+  let* () =
+    match String.length wtid = 32 with
+    | false -> Error "invalid wtid: must be 32 bytes"
+    | true -> Ok ()
+  in
   let master_sig =
     let open Signatures.MasterDrainProfit in
     signf (EddsaSignature.sign ~key)