From 396ace1140ee1dcbb2e7514a6a09a2addd36d36c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Tue, 16 Mar 2021 13:09:31 +0100
Subject: [PATCH] Add Builder_db.User tests

---
 builder-web.opam   |   1 +
 test/builder_db.ml | 121 +++++++++++++++++++++++++++++++++++++++++++++
 test/dune          |   3 ++
 3 files changed, 125 insertions(+)
 create mode 100644 test/builder_db.ml
 create mode 100644 test/dune

diff --git a/builder-web.opam b/builder-web.opam
index 7d7a184..f5b0f68 100644
--- a/builder-web.opam
+++ b/builder-web.opam
@@ -23,6 +23,7 @@ depends: [
   "mirage-crypto-rng"
   "sexplib"
   "scrypt-kdf"
+  "alcotest" {with-test}
 ]
 
 synopsis: "Web interface for builder"
diff --git a/test/builder_db.ml b/test/builder_db.ml
new file mode 100644
index 0000000..f4bbb96
--- /dev/null
+++ b/test/builder_db.ml
@@ -0,0 +1,121 @@
+open Rresult.R.Infix
+
+module type CONN = Caqti_blocking.CONNECTION
+
+let () = Mirage_crypto_rng_unix.initialize ()
+
+let iter f xs = List.fold_left (fun r x -> r >>= fun () -> f x) (Ok ()) xs
+    
+let or_fail x =
+  match x with
+  | Ok x -> x
+  | Error (#Caqti_error.t as e) ->
+    Alcotest.failf "DB error: %a" Caqti_error.pp e
+
+let setup_db () =
+  let () = print_endline "Hello, World!" in
+  Caqti_blocking.connect
+    (Uri.make ~scheme:"sqlite3" ~path:":memory:" ~query:["create", ["true"]] ())
+  >>= fun ((module Db) as conn) ->
+  iter (fun migrate -> Db.exec migrate ()) Builder_db.migrate >>= fun () ->
+  Ok conn
+
+let builder_web_auth =
+  let equal (x : _ Builder_web_auth.user_info) (y : _ Builder_web_auth.user_info) =
+    x.username = y.username &&
+    match x.password_hash, y.password_hash with
+    | `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') ->
+      Cstruct.equal hash hash' &&
+      Cstruct.equal salt salt' &&
+      params = params'
+  in
+  let pp ppf { Builder_web_auth.username; password_hash } =
+    match password_hash with
+    | `Scrypt (hash, salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p }) ->
+      Format.fprintf ppf "user:%s;(%d,%d,%d);%a;%a" username
+        scrypt_n scrypt_r scrypt_p
+        Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt
+  in
+  Alcotest.testable
+    pp
+    equal
+
+let scrypt_params = Builder_web_auth.scrypt_params
+    ~scrypt_n:1024 ~scrypt_r:1 ()
+let username = "test" and password = "testtest"
+(* Bad, but fast *)
+let auth = Builder_web_auth.hash ~scrypt_params ~username ~password ()
+
+let add_test_user (module Db : CONN) =
+  Db.exec Builder_db.User.add auth
+
+let with_user_db f () =
+  or_fail
+    (setup_db () >>= fun conn ->
+     add_test_user conn >>= fun () ->
+     f conn)
+
+let test_user_get_all (module Db : CONN) =
+  Db.collect_list Builder_db.User.get_all () >>| fun users ->
+  Alcotest.(check int) "one user" (List.length users) 1
+
+let test_user_get_user (module Db : CONN) =
+  Db.find_opt Builder_db.User.get_user username >>| fun res ->
+  let auth_opt = Option.map snd res in
+  Alcotest.(check (option builder_web_auth)) "test user" auth_opt (Some auth)
+
+let test_user_remove_user (module Db : CONN) =
+  Db.exec Builder_db.User.remove_user username >>= fun () ->
+  Db.find_opt Builder_db.User.get_user username >>| fun res ->
+  let auth_opt = Option.map snd res in
+  Alcotest.(check (option builder_web_auth)) "remove user" auth_opt None
+
+let test_user_update (module Db : CONN) =
+  let auth' = Builder_web_auth.hash ~scrypt_params ~username
+      ~password:"differentpassword" () in
+  Db.exec Builder_db.User.update_user auth' >>= fun () ->
+  Db.find_opt Builder_db.User.get_user username >>| fun res ->
+  let auth_opt = Option.map snd res in
+  Alcotest.(check (option builder_web_auth)) "update user" auth_opt (Some auth')
+
+let test_user_remove (module Db : CONN) =
+  Db.find_opt Builder_db.User.get_user username >>= function
+  | None ->
+    Alcotest.fail "user not found"
+  | Some (id, _auth') ->
+    Db.exec Builder_db.User.remove id >>= fun () ->
+    Db.find_opt Builder_db.User.get_user username >>| fun res ->
+    let auth_opt = Option.map snd res in
+    Alcotest.(check (option builder_web_auth)) "remove user" auth_opt None
+
+let test_user_auth (module Db : CONN) =
+  Db.find_opt Builder_db.User.get_user username >>| function
+  | None ->
+    Alcotest.fail "user not found"
+  | Some (_id, auth') ->
+    Alcotest.(check bool) "authorized"
+      (Builder_web_auth.verify_password password auth') true
+
+let test_user_unauth (module Db : CONN) =
+  Db.find_opt Builder_db.User.get_user username >>| function
+  | None ->
+    Alcotest.fail "user not found"
+  | Some (_id, auth') ->
+    Alcotest.(check bool) "unauthorized"
+      (Builder_web_auth.verify_password "wrong" auth') false
+
+let () =
+  let open Alcotest in
+  Alcotest.run "Builder_db" [
+    "user", [
+      test_case "One user" `Quick (with_user_db test_user_get_all);
+      test_case "Get user" `Quick (with_user_db test_user_get_user);
+      test_case "Remove user by name" `Quick (with_user_db test_user_remove_user);
+      test_case "Update user" `Quick (with_user_db test_user_update);
+      test_case "Remove user" `Quick (with_user_db test_user_remove);
+    ];
+    "user-auth", [
+      test_case "User auth success" `Quick (with_user_db test_user_auth);
+      test_case "User auth fail" `Quick (with_user_db test_user_unauth);
+    ];
+  ]
diff --git a/test/dune b/test/dune
new file mode 100644
index 0000000..d728f6c
--- /dev/null
+++ b/test/dune
@@ -0,0 +1,3 @@
+(test
+ (name builder_db)
+ (libraries builder_db caqti.blocking alcotest mirage-crypto-rng.unix))