121 lines
4.3 KiB
OCaml
121 lines
4.3 KiB
OCaml
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);
|
|
];
|
|
]
|