Add Builder_db.User tests

This commit is contained in:
Reynir Björnsson 2021-03-16 13:09:31 +01:00
parent 52da2cf588
commit 396ace1140
3 changed files with 125 additions and 0 deletions

View file

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

121
test/builder_db.ml Normal file
View file

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

3
test/dune Normal file
View file

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