builder-web/lib/authorization.ml

let src = Logs.Src.create "authorization" ~doc:"Builder_web authorization"
module Log = (val Logs.src_log src : Logs.LOG)

open Lwt.Syntax

let realm = "builder-web"

let user_info_local = Dream.new_local ~name:"user_info" ()

let authenticate handler = fun req ->
  let unauthorized () =
    let headers = ["WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" realm] in
    Dream.respond ~headers ~status:`Unauthorized "Forbidden!"
  in
  match Dream.session "username" req with
  | Some username ->
    let* user_info = Dream.sql req (Model.user username) in
    begin match user_info with
      | Ok (Some (user_id, user_info)) ->
        handler (Dream.with_local user_info_local (user_id, user_info) req)
      | Ok None ->
        Log.warn (fun m -> m "User %S from session doesn't exist" username);
        let* () = Dream.invalidate_session req in
        Dream.respond ~status:`Internal_Server_Error "Internal server error"
      | Error e ->
        Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e);
        Dream.respond ~status:`Internal_Server_Error "Internal server error"
    end
  | None ->
    match Dream.header "Authorization" req with
    | None -> unauthorized ()
    | Some data -> match String.split_on_char ' ' data with
      | [ "Basic" ; user_pass ] ->
        (match Base64.decode user_pass with
         | Error `Msg msg ->
           Log.info (fun m -> m "Invalid user / pasword encoding in %S: %S" data msg);
           Dream.respond ~status:`Bad_Request "Couldn't decode authorization"
         | Ok user_pass -> match String.split_on_char ':' user_pass with
           | [] | [_] ->
             Log.info (fun m -> m "Invalid user / pasword encoding in %S" data);
             Dream.respond ~status:`Bad_Request "Couldn't decode authorization"
           | user :: password ->
             let pass = String.concat ":" password in
             let* user_info = Dream.sql req (Model.user user) in
             match user_info with
             | Ok (Some (id, user_info)) ->
               if Builder_web_auth.verify_password pass user_info
               then handler (Dream.with_local user_info_local (id, user_info) req)
               else unauthorized ()
             | Ok None ->
               let _ : _ Builder_web_auth.user_info =
                 Builder_web_auth.hash ~username:user ~password:pass ~restricted:true () in
               unauthorized ()
             | Error e ->
               Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e);
               Dream.respond ~status:`Internal_Server_Error "Internal server error")
      | _ ->
        Log.warn (fun m -> m "Error retrieving authorization %S" data);
        Dream.respond ~status:`Bad_Request "Couldn't decode authorization"

let authorized req job_name =
  match Dream.local user_info_local req with
  | None -> Lwt.return (Error (`Msg "not authenticated"))
  | Some (id, user) ->
     if user.restricted then
       Dream.sql req (Model.authorized id job_name)
     else
       Lwt_result.return ()