Use scrypt (#32)

Switch to using scrypt for password hashing

Co-authored-by: Reynir Björnsson <reynir@reynir.dk>
Reviewed-on: https://git.robur.io/robur/builder-web/pulls/32
Co-Authored-By: reynir <reynir@reynir.dk>
Co-Committed-By: reynir <reynir@reynir.dk>

auth/builder_web_auth.ml

@@ -1,51 +1,50 @@
-let prf : Mirage_crypto.Hash.hash = `SHA256
+type pbkdf2_sha256_params = {
-let default_count = 160_000
+  pbkdf2_sha256_iter : int;
-let dk_len = 32l
-
-type user_info = {
-  username : string;
-  password_hash : Cstruct.t;
-  password_salt : Cstruct.t;
-  password_iter : int;
 }
 
-module SMap = Map.Make(String)
+type scrypt_params = {
+  scrypt_n : int;
+  scrypt_r : int;
+  scrypt_p : int;
+}
 
-type t = user_info SMap.t
+let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () =
+  { scrypt_n; scrypt_r; scrypt_p }
 
-let user_info_to_sexp { username; password_hash; password_salt; password_iter } =
+type pbkdf2_sha256 =
-  Sexplib.Sexp.(List [
+  [ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ]
-      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 =
+type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ]
-  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 =
+type password_hash = [ pbkdf2_sha256 | scrypt ]
-  Pbkdf.pbkdf2 ~prf ~count ~dk_len ~salt ~password:(Cstruct.of_string password)
 
-let hash ?(password_iter=default_count) ~username ~password () =
+type 'a user_info = {
+  username : string;
+  password_hash : [< password_hash ] as 'a;
+}
+
+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
+  let password_hash = scrypt ~params:scrypt_params ~salt ~password in
-  { username; password_hash; password_salt = salt; password_iter }
+  {
+    username;
+    password_hash = `Scrypt (password_hash, salt, scrypt_params)
+  }
 
 let verify_password password user_info =
+  match user_info.password_hash with
+  | `Pbkdf2_sha256 (password_hash, salt, params) ->
     Cstruct.equal
-    (h user_info.password_iter user_info.password_salt password)
+      (pbkdf2_sha256 ~params ~salt ~password)
-    user_info.password_hash
+      password_hash
+  | `Scrypt (password_hash, salt, params) ->
+    Cstruct.equal
+      (scrypt ~params ~salt ~password)
+      password_hash

auth/dune

@@ -1,3 +1,3 @@
 (library
  (name builder_web_auth)
- (libraries pbkdf mirage-crypto-rng sexplib))
+ (libraries pbkdf scrypt-kdf mirage-crypto-rng sexplib))

bin/builder_db.ml

@@ -20,7 +20,8 @@ let do_migrate dbpath =
 let migrate () dbpath =
   or_die 1 (do_migrate dbpath)
 
-let user_mod action dbpath password_iter username =
+let user_mod action dbpath scrypt_n scrypt_r scrypt_p username =
+  let scrypt_params = Builder_web_auth.scrypt_params ?scrypt_n ?scrypt_r ?scrypt_p () in
   let r =
     Caqti_blocking.connect
       (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
@@ -29,7 +30,7 @@ let user_mod action dbpath password_iter username =
     flush stdout;
     (* FIXME: getpass *)
     let password = read_line () in
-    let user_info = Builder_web_auth.hash ?password_iter ~username ~password () in
+    let user_info = Builder_web_auth.hash ~scrypt_params ~username ~password () in
     match action with
     | `Add ->
       Db.exec Builder_db.User.add user_info
@@ -38,9 +39,9 @@ let user_mod action dbpath password_iter username =
   in
   or_die 1 r
 
-let user_add () dbpath username = user_mod `Add dbpath username
+let user_add () dbpath = user_mod `Add dbpath
 
-let user_update () dbpath username = user_mod `Update dbpath username
+let user_update () dbpath = user_mod `Update dbpath
 
 let user_list () dbpath =
   let r =
@@ -93,6 +94,24 @@ let password_iter =
                 opt (some int) None &
                 info ~doc ["hash-count"])
 
+let scrypt_n =
+  let doc = "scrypt n parameter" in
+  Cmdliner.Arg.(value &
+                opt (some int) None &
+                info ~doc ["scrypt-n"])
+
+let scrypt_r =
+  let doc = "scrypt r parameter" in
+  Cmdliner.Arg.(value &
+                opt (some int) None &
+                info ~doc ["scrypt-r"])
+
+let scrypt_p =
+  let doc = "scrypt p parameter" in
+  Cmdliner.Arg.(value &
+                opt (some int) None &
+                info ~doc ["scrypt-p"])
+
 let setup_log =
   let setup_log level =
     Logs.set_level level;
@@ -108,12 +127,12 @@ let migrate_cmd =
 
 let user_add_cmd =
   let doc = "add a user" in
-  (Cmdliner.Term.(pure user_add $ setup_log $ dbpath $ password_iter $ username),
+  (Cmdliner.Term.(pure user_add $ setup_log $ dbpath $ scrypt_n $ scrypt_r $ scrypt_p $ username),
    Cmdliner.Term.info ~doc "user-add")
 
 let user_update_cmd =
   let doc = "update a user password" in
-  (Cmdliner.Term.(pure user_update $ setup_log $ dbpath $ password_iter $ username),
+  (Cmdliner.Term.(pure user_update $ setup_log $ dbpath $ scrypt_n $ scrypt_r $ scrypt_p $ username),
    Cmdliner.Term.info ~doc "user-update")
 
 let user_remove_cmd =

bin/migrations/builder_migrations.ml

@@ -75,6 +75,16 @@ let r20210202 =
   Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ dbpath),
   Cmdliner.Term.info ~doc "rollback-2021-02-02"
 
+let m20210216 =
+  let doc = "Changes 'user' for scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
+  Cmdliner.Term.(const do_database_action $ const M20210216.migrate $ setup_log $ dbpath),
+  Cmdliner.Term.info ~doc "migrate-2021-02-16"
+
+let r20210216 =
+  let doc = "Rollback scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
+  Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ dbpath),
+  Cmdliner.Term.info ~doc "rollback-2021-02-16"
+
 let help_cmd =
   let topic =
     let doc = "Migration to get help on" in
@@ -95,5 +105,6 @@ let () =
     [ help_cmd;
       m20210126; r20210126;
       m20210202; r20210202;
+      m20210216; r20210216;
     ]
   |> Cmdliner.Term.exit

bin/migrations/m20210216.ml

@@ -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) ()

builder-web.opam

@@ -22,6 +22,7 @@ depends: [
   "pbkdf"
   "mirage-crypto-rng"
   "sexplib"
+  "scrypt-kdf"
 ]
 
 synopsis: "Web interface for builder"

db/builder_db.ml

@@ -4,7 +4,7 @@ open Rep
 let application_id = 1234839235l
 
 (* Please update this when making changes! *)
-let current_version = 1L
+let current_version = 2L
 
 type id = Rep.id
 
@@ -416,7 +416,9 @@ module User = struct
            username VARCHAR(255) NOT NULL UNIQUE,
            password_hash BLOB NOT NULL,
            password_salt BLOB NOT NULL,
-           password_iter INTEGER NOT NULL
+           scrypt_n INTEGER NOT NULL,
+           scrypt_r INTEGER NOT NULL,
+           scrypt_p INTEGER NOT NULL
          )
       |}
 
@@ -429,7 +431,8 @@ module User = struct
     Caqti_request.find_opt
       Caqti_type.string
       (Caqti_type.tup2 id user_info)
-      {| SELECT id, username, password_hash, password_salt, password_iter
+      {| SELECT id, username, password_hash, password_salt,
+           scrypt_n, scrypt_r, scrypt_p
          FROM user
          WHERE username = ?
       |}
@@ -443,8 +446,9 @@ module User = struct
   let add =
     Caqti_request.exec
       user_info
-      {| INSERT INTO user (username, password_hash, password_salt, password_iter)
+      {| INSERT INTO user (username, password_hash, password_salt,
-         VALUES (?, ?, ?, ?)
+           scrypt_n, scrypt_r, scrypt_p)
+         VALUES (?, ?, ?, ?, ?, ?)
       |}
 
   let remove =
@@ -463,7 +467,9 @@ module User = struct
       {| UPDATE user
          SET password_hash = ?2,
              password_salt = ?3,
-             password_iter = ?4
+             scrypt_n = ?4,
+             scrypt_r = ?5,
+             scrypt_p = ?6
          WHERE username = ?1
       |}
 end

db/builder_db.mli

@@ -138,19 +138,19 @@ module User : sig
   val rollback :
     (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
   val get_user :
-    (string, id * Builder_web_auth.user_info,
+    (string, id * Builder_web_auth.scrypt Builder_web_auth.user_info,
      [< `Many | `One | `Zero > `One `Zero ])
     Caqti_request.t
   val get_all :
     (unit, string, [ `Many | `One | `Zero ]) Caqti_request.t
   val add :
-    (Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ])
+    (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ])
     Caqti_request.t
   val remove : (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
   val remove_user :
     (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
   val update_user :
-    (Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ])
+    (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ])
     Caqti_request.t
 end
 

db/representation.ml

@@ -106,12 +106,18 @@ let console =
   Caqti_type.custom ~encode ~decode cstruct
 
 let user_info =
-  let rep = Caqti_type.(tup4 string cstruct cstruct int) in
+  let rep = Caqti_type.(tup4 string cstruct cstruct (tup3 int int int)) in
-  let encode { Builder_web_auth.username; password_hash;
+  let encode { Builder_web_auth.username;
-               password_salt; password_iter } =
+               password_hash = `Scrypt (password_hash, password_salt, {
-    Ok (username, password_hash, password_salt, password_iter)
+                   Builder_web_auth.scrypt_n; scrypt_r; scrypt_p
-  in
+                 }) }
-  let decode (username, password_hash, password_salt, password_iter) =
+    =
-    Ok { Builder_web_auth.username; password_hash; password_salt; password_iter }
+    Ok (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p))
   in
+  let decode (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p)) =
+    Ok { Builder_web_auth.username;
+         password_hash =
+           `Scrypt (password_hash, password_salt,
+                    { Builder_web_auth.scrypt_n;
+                      scrypt_r; scrypt_p }) }  in
   Caqti_type.custom ~encode ~decode rep

lib/builder_web.ml

@@ -81,7 +81,7 @@ let authorized t handler = fun req ->
       then handler req
       else Lwt.return unauthorized
     | Ok None ->
-      let _ : Builder_web_auth.user_info =
+      let _ : _ Builder_web_auth.user_info =
         Builder_web_auth.hash ~username ~password () in
       Lwt.return unauthorized
     | Error e ->

lib/model.mli

@@ -30,7 +30,7 @@ val jobs : Caqti_lwt.connection ->
   ((Builder_db.id * string) list, [> error ]) result Lwt.t
 
 val user : string -> Caqti_lwt.connection ->
-  (Builder_web_auth.user_info option, [> error ]) result Lwt.t
+  (Builder_web_auth.scrypt Builder_web_auth.user_info option, [> error ]) result Lwt.t
 
 
 val add_build :