Use scrypt (#32)
Switch to using scrypt for password hashing Co-authored-by: Reynir Björnsson <reynir@reynir.dk> Reviewed-on: #32 Co-Authored-By: reynir <reynir@reynir.dk> Co-Committed-By: reynir <reynir@reynir.dk>pull/33/head
parent
8d211dc831
commit
7b81d78554
@ -1,51 +1,50 @@ |
||||
let prf : Mirage_crypto.Hash.hash = `SHA256 |
||||
let default_count = 160_000 |
||||
let dk_len = 32l |
||||
type pbkdf2_sha256_params = { |
||||
pbkdf2_sha256_iter : int; |
||||
} |
||||
|
||||
type scrypt_params = { |
||||
scrypt_n : int; |
||||
scrypt_r : int; |
||||
scrypt_p : int; |
||||
} |
||||
|
||||
let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () = |
||||
{ scrypt_n; scrypt_r; scrypt_p } |
||||
|
||||
type pbkdf2_sha256 = |
||||
[ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ] |
||||
|
||||
type user_info = { |
||||
type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ] |
||||
|
||||
type password_hash = [ pbkdf2_sha256 | scrypt ] |
||||
|
||||
type 'a user_info = { |
||||
username : string; |
||||
password_hash : Cstruct.t; |
||||
password_salt : Cstruct.t; |
||||
password_iter : int; |
||||
password_hash : [< password_hash ] as 'a; |
||||
} |
||||
|
||||
module SMap = Map.Make(String) |
||||
|
||||
type t = user_info SMap.t |
||||
|
||||
let user_info_to_sexp { username; password_hash; password_salt; password_iter } = |
||||
Sexplib.Sexp.(List [ |
||||
Atom "user_info"; |
||||
Atom username; |
||||
Atom (Cstruct.to_string password_hash); |
||||
Atom (Cstruct.to_string password_salt); |
||||
Sexplib.Conv.sexp_of_int password_iter; |
||||
]) |
||||
|
||||
let user_info_of_sexp = |
||||
let open Sexplib.Sexp in |
||||
function |
||||
| List [ Atom "user_info"; |
||||
Atom username; |
||||
Atom password_hash; |
||||
Atom password_salt; |
||||
(Atom _ ) as password_iter; ] -> |
||||
{ username; |
||||
password_hash = Cstruct.of_string password_hash; |
||||
password_salt = Cstruct.of_string password_salt; |
||||
password_iter = Sexplib.Conv.int_of_sexp password_iter; } |
||||
| sexp -> |
||||
Sexplib.Conv.of_sexp_error "Auth_store.user_info_of_sexp: bad sexp" sexp |
||||
|
||||
let h count salt password = |
||||
Pbkdf.pbkdf2 ~prf ~count ~dk_len ~salt ~password:(Cstruct.of_string password) |
||||
|
||||
let hash ?(password_iter=default_count) ~username ~password () = |
||||
let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password = |
||||
Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password:(Cstruct.of_string password) |
||||
|
||||
let scrypt ~params:{ scrypt_n = n; scrypt_r = r; scrypt_p = p } ~salt ~password = |
||||
Scrypt_kdf.scrypt_kdf ~n ~r ~p ~dk_len:32l ~salt ~password:(Cstruct.of_string password) |
||||
|
||||
let hash ?(scrypt_params=scrypt_params ()) |
||||
~username ~password () = |
||||
let salt = Mirage_crypto_rng.generate 16 in |
||||
let password_hash = h password_iter salt password in |
||||
{ username; password_hash; password_salt = salt; password_iter } |
||||
let password_hash = scrypt ~params:scrypt_params ~salt ~password in |
||||
{ |
||||
username; |
||||
password_hash = `Scrypt (password_hash, salt, scrypt_params) |
||||
} |
||||
|
||||
let verify_password password user_info = |
||||
Cstruct.equal |
||||
(h user_info.password_iter user_info.password_salt password) |
||||
user_info.password_hash |
||||
match user_info.password_hash with |
||||
| `Pbkdf2_sha256 (password_hash, salt, params) -> |
||||
Cstruct.equal |
||||
(pbkdf2_sha256 ~params ~salt ~password) |
||||
password_hash |
||||
| `Scrypt (password_hash, salt, params) -> |
||||
Cstruct.equal |
||||
(scrypt ~params ~salt ~password) |
||||
password_hash |
||||
|
||||
@ -1,3 +1,3 @@ |
||||
(library |
||||
(name builder_web_auth) |
||||
(libraries pbkdf mirage-crypto-rng sexplib)) |
||||
(libraries pbkdf scrypt-kdf mirage-crypto-rng sexplib)) |
||||
|
||||
@ -0,0 +1,60 @@ |
||||
let old_user_version = 1L |
||||
let new_user_version = 2L |
||||
|
||||
let set_version version = |
||||
Caqti_request.exec ~oneshot:true |
||||
Caqti_type.unit |
||||
(Printf.sprintf "PRAGMA user_version = %Ld" version) |
||||
|
||||
let drop_user = |
||||
Caqti_request.exec ~oneshot:true |
||||
Caqti_type.unit |
||||
"DROP TABLE user" |
||||
|
||||
let new_user = |
||||
Caqti_request.exec ~oneshot:true |
||||
Caqti_type.unit |
||||
{| CREATE TABLE user ( |
||||
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, |
||||
username VARCHAR(255) NOT NULL UNIQUE, |
||||
password_hash BLOB NOT NULL, |
||||
password_salt BLOB NOT NULL, |
||||
scrypt_n INTEGER NOT NULL, |
||||
scrypt_r INTEGER NOT NULL, |
||||
scrypt_p INTEGER NOT NULL |
||||
) |
||||
|} |
||||
|
||||
let old_user = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
{| CREATE TABLE user ( |
||||
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, |
||||
username VARCHAR(255) NOT NULL UNIQUE, |
||||
password_hash BLOB NOT NULL, |
||||
password_salt BLOB NOT NULL, |
||||
password_iter INTEGER NOT NULL |
||||
) |
||||
|} |
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) = |
||||
let open Rresult.R.Infix in |
||||
Db.find Builder_db.get_application_id () >>= fun application_id -> |
||||
Db.find Builder_db.get_version () >>= fun user_version -> |
||||
if application_id <> Builder_db.application_id || user_version <> old_user_version |
||||
then Error (`Wrong_version (application_id, user_version)) |
||||
else |
||||
Db.exec drop_user () >>= fun () -> |
||||
Db.exec new_user () >>= fun () -> |
||||
Db.exec (set_version new_user_version) () |
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) = |
||||
let open Rresult.R.Infix in |
||||
Db.find Builder_db.get_application_id () >>= fun application_id -> |
||||
Db.find Builder_db.get_version () >>= fun user_version -> |
||||
if application_id <> Builder_db.application_id || user_version <> new_user_version |
||||
then Error (`Wrong_version (application_id, user_version)) |
||||
else |
||||
Db.exec drop_user () >>= fun () -> |
||||
Db.exec old_user () >>= fun () -> |
||||
Db.exec (set_version old_user_version) () |
||||
Loading…
Reference in new issue