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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
module Core = Sihl_core
open Lwt.Syntax
let log_src = Logs.Src.create ~doc:"session" "sihl.service.session"
module Logs = (val Logs.src_log log_src : Logs.LOG)
module Repo = Repo
module Make (Repo : Sig.REPO) : Sig.SERVICE = struct
let make ?expire_date now =
let open Model in
match expire_date, default_expiration_date now with
| Some expire_date, _ ->
Some { key = Core.Random.base64 ~nr:10; data = Map.empty; expire_date }
| None, Some expire_date ->
Some { key = Core.Random.base64 ~nr:10; data = Map.empty; expire_date }
| None, None -> None
;;
let create data =
let empty_session =
match make (Ptime_clock.now ()) with
| Some session -> session
| None ->
Logs.err (fun m ->
m "SESSION: Can not create session, failed to create validity time");
raise (Model.Exception "Can not set session validity time")
in
let session =
List.fold_left
(fun session (key, value) -> Model.set ~key ~value session)
empty_session
data
in
let* () = Repo.insert session in
Lwt.return session
;;
let find_opt = Repo.find_opt
let find ~key =
let* session = Repo.find_opt ~key in
match session with
| Some session -> Lwt.return session
| None ->
Logs.err (fun m -> m "SESSION: Session with key %s not found in database" key);
raise (Model.Exception "Session not found")
;;
let find_all = Repo.find_all
let set session ~key ~value =
let session_key = Model.key session in
let* session = find ~key:session_key in
let session = Model.set ~key ~value session in
Repo.update session
;;
let unset session ~key =
let session_key = Model.key session in
let* session = find ~key:session_key in
let session = Model.remove ~key session in
Repo.update session
;;
let get session ~key =
let session_key = Model.key session in
let* session = find ~key:session_key in
Model.get key session |> Lwt.return
;;
let start () = Lwt.return ()
let stop () = Lwt.return ()
let lifecycle = Core.Container.Lifecycle.create "session" ~start ~stop
let register () =
Repo.register_migration ();
Repo.register_cleaner ();
Core.Container.Service.create lifecycle
;;
end