open Rresult

module Commands = Wire_commands
module Wire_lwt = Wire_lwt

let wire_of_cstruct = Wire_asn.wire_of_cstruct
let wire_to_cstruct = Wire_asn.wire_to_cstruct

type t = {
  host : string;
  cacert : X509.Certificate.t;
  cakey : X509.Private_key.t;
}

let check_csr_dn csr user =
  let subject = 
    [X509.Distinguished_name.(Relative_distinguished_name.singleton (CN user))] in
  if X509.Distinguished_name.equal
      subject
      (X509.Signing_request.info csr).subject
  then Ok ()
  else R.error_msgf "Bad subject in csr: %a"
      X509.Distinguished_name.pp (X509.Signing_request.info csr).subject

let sign t csr user =
  check_csr_dn csr user >>= fun () ->
  let issuer = X509.Certificate.subject t.cacert in
  let email = Printf.sprintf "%s@%s" user t.host in
  let valid_from = Ptime_clock.now () in
  let valid_until =
    Ptime.add_span valid_from 
      (Ptime.Span.of_int_s (Duration.of_day 90 |> Duration.to_sec))
    |> Option.get
  in
  let extensions = 
    let open X509.Extension in
    let auth = Some (X509.Public_key.id (X509.Certificate.public_key t.cacert)),
               X509.General_name.empty, None in
    X509.Extension.empty
    |> add Authority_key_id (false, auth)
    |> add Subject_key_id (false, X509.(Public_key.id (Signing_request.info csr).public_key))
    |> add Subject_alt_name (false, X509.General_name.singleton Rfc_822 [email])
    |> add Ext_key_usage (true, [`Client_auth])
  in
  X509.Signing_request.sign
    csr
    ~valid_from
    ~valid_until
    ~extensions
    t.cakey
    issuer
  |> R.reword_error (fun ve ->
      R.msgf "Signing failed: %a" X509.Validation.pp_validation_error ve)