From 80299f086b0bfb7b4c77844881370a1a0d3c44b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Fri, 11 Dec 2020 16:41:13 +0100
Subject: [PATCH] Add more tests

---
 test/test.ml | 94 +++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 86 insertions(+), 8 deletions(-)

diff --git a/test/test.ml b/test/test.ml
index f73e4ed..125fc7e 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -4,38 +4,116 @@ let csr_privkey =
   lazy
     (`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
 
+let ca_privkey =
+  lazy
+    (`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
+
 let dn_of_name name =
   [X509.(Distinguished_name.Relative_distinguished_name.singleton
            (CN name))]
 
-let csr name =
+let ca_cert =
+  let gen_ca () =
+    let valid_from = Ptime_clock.now () in
+    let valid_until =
+      Ptime.add_span valid_from
+        (Ptime.Span.of_int_s 60)
+      |> Option.get
+    in
+    let subject = dn_of_name "Bad Authority, Inc." in
+    let extensions =
+      let open X509.Extension in
+      empty
+      |> add Key_usage
+        (true, [`Key_cert_sign; `CRL_sign; `Digital_signature; `Content_commitment])
+      |> add Basic_constraints (true, (true, None))
+    in
+    let csr =
+      X509.Signing_request.create
+        subject
+        (Lazy.force ca_privkey)
+    in
+    X509.Signing_request.sign
+      csr
+      ~valid_from
+      ~valid_until
+      ~extensions
+      (Lazy.force ca_privkey)
+      subject
+  in
+  lazy (Result.get_ok (gen_ca ()))
+
+let csr subject =
   X509.Signing_request.create
-    (dn_of_name name)
+    subject
     (Lazy.force csr_privkey)
 
-let check_csr_dn_good () = 
+let check_csr_dn_good () =
   let name = "reynir" in
-  let csr = csr name in
+  let csr = csr (dn_of_name name) in
   Alcotest.(check @@ result unit Alcotest.reject)
     "good dn in csr"
     (Ok ())
     (Cert_service.check_csr_dn
        csr name)
 
-let check_csr_dn_different () = 
+let check_csr_dn_different () =
   let name = "reynir" in
-  let csr = csr name in
+  let csr = csr (dn_of_name name) in
   match Cert_service.check_csr_dn csr "notreynir" with
   | Ok () -> Alcotest.fail "check succeeded, expected failure"
   | Error (`Msg _) -> ()
 
-let cert_tests = [
+let check_csr_dn_extra () =
+  let name = "reynir" in
+  let csr = csr (dn_of_name name @ dn_of_name "bob") in
+  match Cert_service.check_csr_dn csr "notreynir" with
+  | Ok () -> Alcotest.fail "check succeeded, expected failure"
+  | Error (`Msg _) -> ()
+
+let check_csr_tests = [
   "check_csr_dn_good", `Quick, check_csr_dn_good;
   "check_csr_dn_different", `Quick, check_csr_dn_different;
+  "check_csr_dn_extra", `Quick, check_csr_dn_extra;
+]
+
+let good_sign () =
+  let t = {
+    Cert_service.host = "example.com";
+    cacert = Lazy.force ca_cert;
+    cakey = Lazy.force ca_privkey;
+  }
+  in
+  let name = "reynir" in
+  let csr = csr (dn_of_name name) in
+  match Cert_service.sign t csr name with
+  | Ok _cert -> ()
+  | Error (`Msg e) -> Alcotest.failf "cert sign failed unexpectedly: %s" e
+
+let bad_sign () =
+  let t = {
+    Cert_service.host = "example.com";
+    cacert = Lazy.force ca_cert;
+    cakey = Lazy.force ca_privkey;
+  }
+  in
+  let name = "reynir" in
+  let csr = csr (dn_of_name name) in
+  match Cert_service.sign t csr "notreynir" with
+  | Ok cert ->
+    Alcotest.failf
+      "cert sign succeeded unexpectedly:\n%a" X509.Certificate.pp
+      cert
+  | Error (`Msg _) -> ()
+
+let cert_tests = [
+  "good_sign", `Slow, good_sign;
+  "bad_sign", `Slow, bad_sign;
 ]
 
 let tests : unit Alcotest.test list= [
-  "check_csr_dn", cert_tests
+  "check_csr_dn", check_csr_tests;
+  "cert_tests", cert_tests;
 ]
 
 let () =