Source file `message_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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
open Base
open Lwt.Syntax
module Entry = Message_core.Entry
module Sig = Message_service_sig

let session_key = "message"

module Make
    (Log : Log.Service.Sig.SERVICE)
    (SessionService : Session.Service.Sig.SERVICE) : Sig.SERVICE = struct
  let fetch_entry ctx =
    let* entry = SessionService.get ~key:session_key ctx in
    match entry with
    | None -> Lwt.return None
    | Some entry -> (
        match entry |> Entry.of_string with
        | Ok entry -> Lwt.return (Some entry)
        | Error msg ->
            Log.warn (fun m ->
                m "MESSAGE: Invalid flash message in session %s" msg);
            Lwt.return None )

  let find_current ctx =
    let* entry = fetch_entry ctx in
    match entry with
    | None -> Lwt.return None
    | Some entry -> Lwt.return (Entry.current entry)

  let set_next ctx message =
    let* entry = fetch_entry ctx in
    match entry with
    | None ->
        (* No entry found, creating new one *)
        let entry = Entry.create message |> Entry.to_string in
        SessionService.set ctx ~key:session_key ~value:entry
    | Some entry ->
        (* Overriding next message in existing entry *)
        let entry = Entry.set_next message entry |> Entry.to_string in
        SessionService.set ctx ~key:session_key ~value:entry

  let rotate ctx =
    let* entry = fetch_entry ctx in
    match entry with
    | None -> Lwt.return None
    | Some entry ->
        let serialized_entry = entry |> Entry.rotate |> Entry.to_string in
        let* () =
          SessionService.set ctx ~key:session_key ~value:serialized_entry
        in
        Lwt.return @@ Message_core.Entry.next entry

  let current ctx =
    let* entry = find_current ctx in
    match entry with
    | None -> Lwt.return None
    | Some message -> Lwt.return (Some message)

  let set ctx ?(error = []) ?(warning = []) ?(success = []) ?(info = []) () =
    let message =
      Message_core.Message.(
        empty |> set_error error |> set_warning warning |> set_success success
        |> set_info info)
    in
    set_next ctx message
end