mte/src/devices.ml

type env = {
  caqti_switch: Caqti_miou.Switch.t;
  db_uri: Uri.t;
}

let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
  let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
  Vif.Device.v ~name:"db_connection" ~finally []
  @@ fun { caqti_switch; db_uri } ->
  match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
  | Error err ->
      Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
  | Ok conn -> (
      match Pg.preflight conn with
      | Error err ->
          Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
      | Ok () -> conn)

(* TODO KV store *)

module Secmod_signkey = struct
  type t = {
    sm_key: Signkey.t;
    keys: Signkey.t list;
  }

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

  let read_eddsa_key_files fname =
    let open Syntax in
    let open Bos.OS in
    let open Crypto in
    let pub = Fpath.(dir / fname) |> Fpath.set_ext "pub" in
    let priv = Fpath.(dir / fname) |> Fpath.set_ext "priv" in
    let* b0 = File.exists pub in
    let* b1 = File.exists priv in
    match (b0, b1) with
    | true, true ->
        let* pub = File.read pub in
        let* priv = File.read priv in
        let pub = EddsaPublicKey.of_octets pub in
        let priv = EddsaPrivateKey.of_octets priv in
        Ok (Some (pub, priv))
    | false, false -> Ok None
    | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.")

  let write_eddsa_key_files fname signkey =
    let open Syntax in
    let open Bos.OS in
    let open Crypto in
    let pub_file = Fpath.(dir / fname) |> Fpath.set_ext "pub" in
    let priv_file = Fpath.(dir / fname) |> Fpath.set_ext "priv" in
    let pub = EddsaPublicKey.to_octets signkey.Signkey.pub in
    let priv = EddsaPrivateKey.to_octets signkey.priv in
    let* () = File.write pub_file pub in
    let* () = File.write priv_file priv in
    Ok ()

  let write_local_keys t =
    let open Syntax in
    let* () = write_eddsa_key_files "sm_key" t.sm_key in
    let keys = List.mapi (fun i key -> (string_of_int i, key)) t.keys in
    let* () = list_iter (fun (s, key) -> write_eddsa_key_files s key) keys in
    Ok ()

  let load_local_keys conn =
    let open Syntax in
    let load s =
      let* opt = read_eddsa_key_files s in
      match opt with
      | None -> Ok None
      | Some (pub, priv) -> (
          let* opt = Pg.lookup_signing_key conn pub in
          match opt with
          | None ->
              Fmt.error_msg
                "secmod_signkey error: no associtaed metadata found in \
                 database for key `%s`."
                s
          | Some (stamp_start, stamp_expire, stamp_end) ->
              let master_sig = None in
              Ok
                (Some
                   Signkey.
                     {
                       pub;
                       priv;
                       stamp_start;
                       stamp_expire;
                       stamp_end;
                       master_sig;
                     }))
    in
    let* sm_key = load "sm_key" in
    let* key_0 = load "0" in
    match (sm_key, key_0) with
    | None, None -> Ok None
    | Some sm_key, Some key_0 ->
        let keys = [ key_0 ] in
        Ok (Some { sm_key; keys })
    | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.")

  let generate_fresh_keys () =
    let sm_key = Signkey.generate () in
    let keys = [ Signkey.generate () ] in
    { sm_key; keys }

  let v =
    let finally _key = () in
    Vif.Device.v ~name:"secmod_signkey" ~finally
      [ Vif.Device.value db_connection ]
    @@ fun conn (_env : env) ->
    match load_local_keys conn with
    | Ok None ->
        Fmt.pr "secmod_signkey: generate_fresh_keys@.";
        let t = generate_fresh_keys () in
        write_local_keys t |> Result.get_ok;
        t
    | Ok (Some v) ->
        Fmt.pr "secmod_signkey: loaded local keys@.";
        v
    | Error _ ->
        (* TODO pp error *)
        Fmt.failwith "secmod_signkey init failure."
end

module Secmod_denom = struct
  type t = {
    sm_key: Signkey.t;
    keys: Denomination.t list;
  }

  let v =
    let finally _key = () in
    Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
    let sm_key = Signkey.generate () in
    let keys = List.map Denomination.make Config.Coin.all_coins in
    { sm_key; keys }
end

let secmod_signkey = Secmod_signkey.v
let secmod_denom = Secmod_denom.v