package sihl

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file 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
33
34
35
36
37
38
39
40
41
42
43
44
45
open Lwt.Syntax
module Core = Sihl_core
module Session = Sihl_session
module User = Sihl_user

exception Exception of string

let log_src = Logs.Src.create ~doc:"authn" "sihl.service.authn"

module Logs = (val Logs.src_log log_src : Logs.LOG)

module Make (SessionService : Session.Sig.SERVICE) (UserService : User.Sig.SERVICE) :
  Sig.SERVICE = struct
  let find_user_in_session_opt session =
    let* user_id = SessionService.get session ~key:"authn" in
    match user_id with
    | None -> Lwt.return None
    | Some user_id -> UserService.find_opt ~user_id
  ;;

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

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

  let unauthenticate_session session = SessionService.unset session ~key:"authn"
  let start () = Lwt.return ()
  let stop _ = Lwt.return ()

  let lifecycle =
    Core.Container.Lifecycle.create
      "authn"
      ~start
      ~stop
      ~dependencies:[ SessionService.lifecycle; UserService.lifecycle ]
  ;;

  let register () = Core.Container.Service.create lifecycle
end
OCaml

Innovation. Community. Security.