Add Builder_db.User tests

builder-web.opam

@@ -23,6 +23,7 @@ depends: [
   "mirage-crypto-rng"
   "sexplib"
   "scrypt-kdf"
+  "alcotest" {with-test}
 ]
 
 synopsis: "Web interface for builder"

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);
+    ];
+  ]

test/dune

@@ -0,0 +1,3 @@
+(test
+ (name builder_db)
+ (libraries builder_db caqti.blocking alcotest mirage-crypto-rng.unix))