This repository has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module State_change = struct
7 type type_state = {
8 type_name : string;
9 state : string;
10 }
11
12 type t = {
13 type_ : string;
14 changed : (Proto_id.t * type_state list) list;
15 }
16
17 (* The changed object is account_id -> { typeName: state } *)
18 let changed_jsont =
19 let kind = "Changed" in
20 (* Inner is type -> state string map *)
21 let type_states_jsont = Proto_json_map.of_string Jsont.string in
22 (* Convert list of (string * string) to type_state list *)
23 let decode_type_states pairs =
24 List.map (fun (type_name, state) -> { type_name; state }) pairs
25 in
26 let encode_type_states states =
27 List.map (fun ts -> (ts.type_name, ts.state)) states
28 in
29 Proto_json_map.of_id
30 (Jsont.map ~kind ~dec:decode_type_states ~enc:encode_type_states type_states_jsont)
31
32 let make type_ changed = { type_; changed }
33
34 let jsont =
35 let kind = "StateChange" in
36 Jsont.Object.map ~kind make
37 |> Jsont.Object.mem "@type" Jsont.string ~enc:(fun t -> t.type_)
38 |> Jsont.Object.mem "changed" changed_jsont ~enc:(fun t -> t.changed)
39 |> Jsont.Object.finish
40end
41
42type push_keys = {
43 p256dh : string;
44 auth : string;
45}
46
47let push_keys_make p256dh auth = { p256dh; auth }
48
49let push_keys_jsont =
50 let kind = "PushKeys" in
51 Jsont.Object.map ~kind push_keys_make
52 |> Jsont.Object.mem "p256dh" Jsont.string ~enc:(fun k -> k.p256dh)
53 |> Jsont.Object.mem "auth" Jsont.string ~enc:(fun k -> k.auth)
54 |> Jsont.Object.finish
55
56type t = {
57 id : Proto_id.t;
58 device_client_id : string;
59 url : string;
60 keys : push_keys option;
61 verification_code : string option;
62 expires : Ptime.t option;
63 types : string list option;
64}
65
66let id t = t.id
67let device_client_id t = t.device_client_id
68let url t = t.url
69let keys t = t.keys
70let verification_code t = t.verification_code
71let expires t = t.expires
72let types t = t.types
73
74let make id device_client_id url keys verification_code expires types =
75 { id; device_client_id; url; keys; verification_code; expires; types }
76
77let jsont =
78 let kind = "PushSubscription" in
79 Jsont.Object.map ~kind make
80 |> Jsont.Object.mem "id" Proto_id.jsont ~enc:id
81 |> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:device_client_id
82 |> Jsont.Object.mem "url" Jsont.string ~enc:url
83 |> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:keys
84 |> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:verification_code
85 |> Jsont.Object.opt_mem "expires" Proto_date.Utc.jsont ~enc:expires
86 |> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:types
87 |> Jsont.Object.finish
88
89let get_args_jsont = Proto_method.get_args_jsont
90let get_response_jsont = Proto_method.get_response_jsont jsont
91
92type create_args = {
93 device_client_id : string;
94 url : string;
95 keys : push_keys option;
96 verification_code : string option;
97 types : string list option;
98}
99
100let create_args_make device_client_id url keys verification_code types =
101 { device_client_id; url; keys; verification_code; types }
102
103let create_args_jsont =
104 let kind = "PushSubscription create" in
105 Jsont.Object.map ~kind create_args_make
106 |> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:(fun a -> a.device_client_id)
107 |> Jsont.Object.mem "url" Jsont.string ~enc:(fun a -> a.url)
108 |> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:(fun a -> a.keys)
109 |> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:(fun a -> a.verification_code)
110 |> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:(fun a -> a.types)
111 |> Jsont.Object.finish
112
113type set_args = {
114 account_id : Proto_id.t option;
115 if_in_state : string option;
116 create : (Proto_id.t * create_args) list option;
117 update : (Proto_id.t * Jsont.json) list option;
118 destroy : Proto_id.t list option;
119}
120
121let set_args_make account_id if_in_state create update destroy =
122 { account_id; if_in_state; create; update; destroy }
123
124let set_args_jsont =
125 let kind = "PushSubscription/set args" in
126 Jsont.Object.map ~kind set_args_make
127 |> Jsont.Object.opt_mem "accountId" Proto_id.jsont ~enc:(fun a -> a.account_id)
128 |> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)
129 |> Jsont.Object.opt_mem "create" (Proto_json_map.of_id create_args_jsont) ~enc:(fun a -> a.create)
130 |> Jsont.Object.opt_mem "update" (Proto_json_map.of_id Jsont.json) ~enc:(fun a -> a.update)
131 |> Jsont.Object.opt_mem "destroy" (Jsont.list Proto_id.jsont) ~enc:(fun a -> a.destroy)
132 |> Jsont.Object.finish