seppo/lib/auth.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * auth.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Astring

(* Password reset:
 *
 * delete the file Auth.fn
*)

let  fn = "app/etc/passwd.s"
type uid    = Uid    of string
type bcrypt = Bcrypt of string
let  dummy  = Uid ""

let is_setup = File.exists

let to_file fn (Uid uid, pwd) =
  Logr.debug (fun m -> m "to_file '%s' ..." uid);
  let h = Bcrypt.hash pwd |> Bcrypt.string_of_hash in
  fn |> File.out_channel_replace (fun oc ->
      Csexp.(List [ Atom "uid"; Atom uid; Atom "bcrypt"; Atom h ] |> to_channel oc);
      Ok fn )

let from_file fn =
  fn |> File.in_channel (fun ic ->
      let open Csexp in
      match input ic with
      | Ok List [ Atom "uid"; Atom uid; Atom "bcrypt"; Atom hash ] -> Ok (Uid uid, Bcrypt hash)
      | Error _ as e -> e
      | _ -> Error "invalid credential store" )

let uid_from_file fn =
  Logr.debug (fun m -> m "Auth.uid_from_file");
  try
    match from_file fn with
    | Ok (uid, _) -> Ok uid
    | Error _ as e -> e
  with
  | Sys_error e -> Error e

(* https://opam.ocaml.org/packages/safepass/ *)
let chk (Uid uid', Bcrypt hash') (Uid uid, pwd) =
  Logr.debug (fun m -> m "Auth.chk '%s' '%s'" uid "***");
  if hash'
     |> Bcrypt.hash_of_string
     |> Bcrypt.verify pwd
  && String.equal uid' uid
  then Ok (Uid uid)
  else Error "invalid username or password"

let chk_file fn cred =
  match from_file fn with
  | Ok v -> chk v cred
  | Error _ as e -> e

(* https://opam.ocaml.org/packages/safepass/ *)
let verify cred (uid', hash') =
  let level = Logs.Debug
  and error = Http.s403' in
  chk (uid',hash') cred
  |> Result.map_error (Http.err500 ~error ~level "Auth.verify")

let verify_file fn cred =
  let level = Logs.Debug
  and error = Http.s403' in
  chk_file fn cred
  |> Result.map_error (Http.err500 ~error ~level "Auth.verify_file")