Source file `authn_service.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
open Lwt.Syntax
module Sig = Authn_service_sig

exception Exception of string

module Make
    (Log : Log.Service.Sig.SERVICE)
    (SessionService : Session.Service.Sig.SERVICE)
    (UserService : User.Service.Sig.SERVICE) : Sig.SERVICE = struct
  let lifecycle =
    Core.Container.Lifecycle.make "authn"
      ~dependencies:[ SessionService.lifecycle; UserService.lifecycle ]
      (fun ctx -> Lwt.return ctx)
      (fun _ -> Lwt.return ())

  let find_user_in_session_opt ctx =
    let* user_id = SessionService.get ctx ~key:"authn" in
    match user_id with
    | None -> Lwt.return None
    | Some user_id -> UserService.find_opt ctx ~user_id

  let find_user_in_session ctx =
    let* user_id = SessionService.get ctx ~key:"authn" in
    match user_id with
    | None -> raise @@ Exception "No user found in current session"
    | Some user_id -> UserService.find ctx ~user_id

  let authenticate_session ctx user =
    SessionService.set ctx ~key:"authn" ~value:(User.id user)

  let unauthenticate_session ctx = SessionService.unset ctx ~key:"authn"
end