package sihl-email

You can search for identifiers within the package.
in-package search v0.2.0
sihl-email
- Library sihl-email
  - Sihl_email
    
    Core
    
    Utils
    
    Template
    
    Make
    
    Logs
    
    MakeSmtp
    
    MakeSendGrid
    
    MakeQueued
    
    Template_repo
    
    Sig
    
    MakeMariaDb
    
    MakePostgreSql
- Sources
  - sihl-email
    
    sihl_email.ml
    
    sihl_email__.ml
    
    sihl_email_template.ml
    
    sihl_email_template_repo.ml
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file `sihl_email_template_repo.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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
module type Sig = sig
  val register_migration : unit -> unit
  val register_cleaner : unit -> unit
  val get : id:string -> Sihl_type.Email_template.t option Lwt.t
  val get_by_name : name:string -> Sihl_type.Email_template.t option Lwt.t
  val insert : template:Sihl_type.Email_template.t -> unit Lwt.t
  val update : template:Sihl_type.Email_template.t -> unit Lwt.t
end

module MakeMariaDb (MigrationService : Sihl_contract.Migration.Sig) : Sig = struct
  let template =
    let open Sihl_type.Email_template in
    let encode m =
      Ok (m.id, (m.name, (m.content_text, (m.content_html, m.created_at))))
    in
    let decode (id, (name, (content_text, (content_html, created_at)))) =
      Ok { id; name; content_text; content_html; created_at }
    in
    Caqti_type.(
      custom ~encode ~decode (tup2 string (tup2 string (tup2 string (tup2 string ptime)))))
  ;;

  module Sql = struct
    module Model = Sihl_type.Email_template

    let get_request =
      Caqti_request.find_opt
        Caqti_type.string
        template
        {sql|
        SELECT
          LOWER(CONCAT(
           SUBSTR(HEX(uuid), 1, 8), '-',
           SUBSTR(HEX(uuid), 9, 4), '-',
           SUBSTR(HEX(uuid), 13, 4), '-',
           SUBSTR(HEX(uuid), 17, 4), '-',
           SUBSTR(HEX(uuid), 21)
           )),
          name,
          content_text,
          content_html,
          created_at
        FROM email_templates
        WHERE email_templates.uuid = UNHEX(REPLACE(?, '-', ''))
        |sql}
    ;;

    let get ~id =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.find_opt get_request id
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let get_by_name_request =
      Caqti_request.find_opt
        Caqti_type.string
        template
        {sql|
        SELECT
          LOWER(CONCAT(
           SUBSTR(HEX(uuid), 1, 8), '-',
           SUBSTR(HEX(uuid), 9, 4), '-',
           SUBSTR(HEX(uuid), 13, 4), '-',
           SUBSTR(HEX(uuid), 17, 4), '-',
           SUBSTR(HEX(uuid), 21)
           )),
          name,
          content_text,
          content_html,
          created_at
        FROM email_templates
        WHERE email_templates.name = ?
        |sql}
    ;;

    let get_by_name ~name =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.find_opt get_by_name_request name
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let insert_request =
      Caqti_request.exec
        template
        {sql|
        INSERT INTO email_templates (
          uuid,
          name,
          content_text,
          content_html,
          created_at
        ) VALUES (
          UNHEX(REPLACE(?, '-', '')),
          ?,
          ?,
          ?,
          ?
        )
        |sql}
    ;;

    let insert ~template =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec insert_request template
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let update_request =
      Caqti_request.exec
        template
        {sql|
        UPDATE email_templates
        SET
          name = $2,
          content_text = $3,
          content_html = $4,
          created_at = $5
        WHERE email_templates.uuid = UNHEX(REPLACE($1, '-', ''))
        |sql}
    ;;

    let update ~template =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec update_request template
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let clean_request =
      Caqti_request.exec
        Caqti_type.unit
        {sql|
        TRUNCATE TABLE email_templates;
         |sql}
    ;;

    let clean () =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec clean_request ()
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;
  end

  module Migration = struct
    let fix_collation =
      Sihl_type.Migration.create_step
        ~label:"fix collation"
        "SET collation_server = 'utf8mb4_unicode_ci'"
    ;;

    let create_templates_table =
      Sihl_type.Migration.create_step
        ~label:"create templates table"
        {sql|
CREATE TABLE IF NOT EXISTS email_templates (
  id BIGINT UNSIGNED AUTO_INCREMENT,
  uuid BINARY(16) NOT NULL,
  name VARCHAR(128) NOT NULL,
  content_text TEXT NOT NULL,
  content_html TEXT NOT NULL,
  created_at TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (id),
  CONSTRAINT unique_uuid UNIQUE KEY (uuid),
  CONSTRAINT unique_name UNIQUE KEY (name)
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci;
|sql}
    ;;

    let migration () =
      Sihl_type.Migration.(
        empty "email" |> add_step fix_collation |> add_step create_templates_table)
    ;;
  end

  let register_migration () = MigrationService.register_migration (Migration.migration ())
  let register_cleaner () = Sihl_persistence.Repository.register_cleaner Sql.clean
  let get = Sql.get
  let get_by_name = Sql.get_by_name
  let insert = Sql.insert
  let update = Sql.update
end

module MakePostgreSql (MigrationService : Sihl_contract.Migration.Sig) : Sig = struct
  let template =
    let open Sihl_type.Email_template in
    let encode m =
      Ok (m.id, (m.name, (m.content_text, (m.content_html, m.created_at))))
    in
    let decode (id, (name, (content_text, (content_html, created_at)))) =
      Ok { id; name; content_text; content_html; created_at }
    in
    Caqti_type.(
      custom ~encode ~decode (tup2 string (tup2 string (tup2 string (tup2 string ptime)))))
  ;;

  module Sql = struct
    module Model = Sihl_type.Email_template

    let get_request =
      Caqti_request.find_opt
        Caqti_type.string
        template
        {sql|
        SELECT
          uuid,
          name,
          content_text,
          content_html,
          created_at
        FROM email_templates
        WHERE email_templates.uuid = ?
        |sql}
    ;;

    let get ~id =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.find_opt get_request id
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let get_by_name_request =
      Caqti_request.find_opt
        Caqti_type.string
        template
        {sql|
        SELECT
          uuid,
          name,
          content_text,
          content_html,
          created_at
        FROM email_templates
        WHERE email_templates.name = ?
        |sql}
    ;;

    let get_by_name ~name =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.find_opt get_by_name_request name
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let insert_request =
      Caqti_request.exec
        template
        {sql|
        INSERT INTO email_templates (
          uuid,
          name,
          content_text,
          content_html,
          created_at
        ) VALUES (
          ?,
          ?,
          ?,
          ?,
          ?
        )
        |sql}
    ;;

    let insert ~template =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec insert_request template
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let update_request =
      Caqti_request.exec
        template
        {sql|
        UPDATE email_templates
        SET
          name = $2,
          content_text = $3,
          content_html = $4,
          created_at = $5
        WHERE email_templates.uuid = $1
        |sql}
    ;;

    let update ~template =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec update_request template
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;

    let clean_request =
      Caqti_request.exec Caqti_type.unit "TRUNCATE TABLE email_templates CASCADE;"
    ;;

    let clean () =
      Sihl_persistence.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
          Connection.exec clean_request ()
          |> Lwt.map Sihl_persistence.Database.raise_error)
    ;;
  end

  module Migration = struct
    let create_templates_table =
      Sihl_type.Migration.create_step
        ~label:"create templates table"
        {sql|
CREATE TABLE IF NOT EXISTS email_templates (
  id SERIAL,
  uuid UUID NOT NULL,
  name VARCHAR(128) NOT NULL,
  content_text TEXT NOT NULL,
  content_html TEXT NOT NULL,
  created_at TIMESTAMPTZ NOT NULL DEFAULT NOW(),
  PRIMARY KEY (id),
  UNIQUE (uuid),
  UNIQUE (name)
);
|sql}
    ;;

    let migration () =
      Sihl_type.Migration.(empty "email" |> add_step create_templates_table)
    ;;
  end

  let register_migration () = MigrationService.register_migration (Migration.migration ())
  let register_cleaner () = Sihl_persistence.Repository.register_cleaner Sql.clean
  let get = Sql.get
  let get_by_name = Sql.get_by_name
  let insert = Sql.insert
  let update = Sql.update
end
package sihl-email

Source file sihl_email_template_repo.ml

Source file `sihl_email_template_repo.ml`
