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
module type Sig = sig
val lifecycles : Sihl.Container.lifecycle list
val register_migration : unit -> unit
val register_cleaner : unit -> unit
val find : string -> string option Lwt.t
val insert : string * string -> unit Lwt.t
val update : string * string -> unit Lwt.t
val delete : string -> unit Lwt.t
end
let find_request =
Caqti_request.find_opt
Caqti_type.string
Caqti_type.string
{sql|
SELECT
cache_value
FROM cache
WHERE cache.cache_key = ?
|sql}
;;
let find key =
Sihl.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
Connection.find_opt find_request key |> Lwt.map Sihl.Database.raise_error)
;;
let insert_request =
Caqti_request.exec
Caqti_type.(tup2 string string)
{sql|
INSERT INTO cache (
cache_key,
cache_value
) VALUES (
?,
?
)
|sql}
;;
let insert key_value =
Sihl.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
Connection.exec insert_request key_value
|> Lwt.map Sihl.Database.raise_error)
;;
let update_request =
Caqti_request.exec
Caqti_type.(tup2 string string)
{sql|
UPDATE cache SET
cache_value = $2
WHERE cache_key = $1
|sql}
;;
let update key_value =
Sihl.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
Connection.exec update_request key_value
|> Lwt.map Sihl.Database.raise_error)
;;
let delete_request =
Caqti_request.exec
Caqti_type.string
{sql|
DELETE FROM cache
WHERE cache.cache_key = ?
|sql}
;;
let delete key =
Sihl.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
Connection.exec delete_request key |> Lwt.map Sihl.Database.raise_error)
;;
let clean_request = Caqti_request.exec Caqti_type.unit "TRUNCATE TABLE cache;"
let clean () =
Sihl.Database.query (fun (module Connection : Caqti_lwt.CONNECTION) ->
Connection.exec clean_request () |> Lwt.map Sihl.Database.raise_error)
;;
module MakeMariaDb (MigrationService : Sihl.Contract.Migration.Sig) : Sig =
struct
let lifecycles = [ Sihl.Database.lifecycle; MigrationService.lifecycle ]
let find = find
let insert = insert
let update = update
let delete = delete
let clean = clean
module Migration = struct
let create_cache_table =
Sihl.Database.Migration.create_step
~label:"create cache table"
{sql|
CREATE TABLE IF NOT EXISTS cache (
id serial,
cache_key VARCHAR(64) NOT NULL,
cache_value VARCHAR(1024) NOT NULL,
created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
PRIMARY KEY(id),
CONSTRAINT unique_key UNIQUE(cache_key)
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci;
|sql}
;;
let migration () =
Sihl.Database.Migration.(empty "cache" |> add_step create_cache_table)
;;
end
let register_migration () =
MigrationService.register_migration (Migration.migration ())
;;
let register_cleaner () = Sihl.Cleaner.register_cleaner clean
end
module MakePostgreSql (MigrationService : Sihl.Contract.Migration.Sig) : Sig =
struct
let lifecycles = [ Sihl.Database.lifecycle; MigrationService.lifecycle ]
let find = find
let insert = insert
let update = update
let delete = delete
let clean = clean
module Migration = struct
let create_cache_table =
Sihl.Database.Migration.create_step
~label:"create cache table"
{sql|
CREATE TABLE IF NOT EXISTS cache (
id serial,
cache_key VARCHAR NOT NULL,
cache_value TEXT NOT NULL,
created_at TIMESTAMP WITH TIME ZONE DEFAULT CURRENT_TIMESTAMP,
PRIMARY KEY (id),
UNIQUE (cache_key)
);
|sql}
;;
let remove_timezone =
Sihl.Database.Migration.create_step
~label:"remove timezone info from timestamps"
{sql|
ALTER TABLE cache
ALTER COLUMN created_at TYPE TIMESTAMP
|sql}
;;
let migration () =
Sihl.Database.Migration.(
empty "cache" |> add_step create_cache_table |> add_step remove_timezone)
;;
end
let register_migration () =
MigrationService.register_migration (Migration.migration ())
;;
let register_cleaner () = Sihl.Cleaner.register_cleaner clean
end