mte/src/secmod_signkey.ml

(* TODO
   - key rotation
   - how many signkey to use?
     we just use 1 for now *)
open Syntax

type exchange_pub = Crypto.EddsaPublicKey.t

type t = {
  lock: Miou.Mutex.t;
  sm_key: Signkey.t;
  signkey_ht: (exchange_pub, Signkey.t) Hashtbl.t;
  revoked_ht:
    (exchange_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t;
}

let get_sm_key t = t.sm_key

let get_signkeys t =
  Miou.Mutex.protect t.lock @@ fun () ->
  Hashtbl.to_seq_values t.signkey_ht |> List.of_seq

let add_master_signatures conn t l =
  Miou.Mutex.protect t.lock @@ fun () ->
  list_iter
    (fun (pub, master_sig) ->
      match Hashtbl.find_opt t.signkey_ht pub with
      | None -> Error "secmod_signkey failure: public key not found."
      | Some signkey ->
          let signkey = { signkey with master_sig= Some master_sig } in
          let* () =
            Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti
          in
          Hashtbl.replace t.signkey_ht pub signkey;
          Ok ())
    l

let revoke_signkey t exchange_pub master_sig =
  Miou.Mutex.protect t.lock @@ fun () ->
  match Hashtbl.find_opt t.signkey_ht exchange_pub with
  | None -> Error "secmod_denom failure: denomination hash not found."
  | Some signkey ->
      Hashtbl.remove t.signkey_ht exchange_pub;
      Hashtbl.replace t.revoked_ht exchange_pub (signkey, master_sig);
      Ok ()

let dir = Fpath.(v "data" / "secmod_signkey")

let _store_secmod_data t =
  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
  get_signkeys t
  |> List.mapi (fun i key ->
      let fname = Fpath.(dir / string_of_int i) in
      (fname, key.Signkey.priv))
  |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)

let load conn =
  let error_invalid_state =
    Fmt.error_msg "secmod_signkey load error: invalid store state."
  in
  let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
  let* signkeys =
    let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
    let* l =
      Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l
    in
    match Syntax.opt_list l with
    | Error () -> error_invalid_state
    | Ok opt -> Ok opt
  in
  match (sm_key, signkeys) with
  | None, None -> Ok None
  | Some sm_key, Some signkeys ->
      let lock = Miou.Mutex.create () in
      let signkey_ht =
        signkeys
        |> List.map (fun v -> (v.Signkey.pub, v))
        |> List.to_seq
        |> Hashtbl.of_seq
      in
      let revoked_ht = Hashtbl.create 0xff in
      Ok (Some { lock; sm_key; signkey_ht; revoked_ht })
  | _, _ -> error_invalid_state

let make_new () =
  let lock = Miou.Mutex.create () in
  let sm_key = Signkey.make () in
  let signkeys = [ Signkey.make () ] in
  let signkey_ht =
    signkeys
    |> List.map (fun v -> (v.Signkey.pub, v))
    |> List.to_seq
    |> Hashtbl.of_seq
  in
  let revoked_ht = Hashtbl.create 0xff in
  { lock; sm_key; signkey_ht; revoked_ht }

let init conn =
  match load conn with
  | Ok None ->
      let t = make_new () in
      Logs.info (fun m -> m "secmod_signkey initialized with fresh keys");
      t
  | Ok (Some v) ->
      Logs.info (fun m -> m "secmod_signkey initialized from storage");
      v
  | Error _ ->
      (* TODO error: pretty print *)
      Fmt.failwith "secmod_signkey init failure."