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
module type Sig = sig
val lifecycles : Sihl.Container.lifecycle list
val register_migration : unit -> unit
val register_cleaner : unit -> unit
val find : ?ctx:(string * string) list -> string -> string option Lwt.t
val insert : ?ctx:(string * string) list -> string * string -> unit Lwt.t
val update : ?ctx:(string * string) list -> string * string -> unit Lwt.t
val delete : ?ctx:(string * string) list -> string -> unit Lwt.t
end
let find_request =
let open Caqti_request.Infix in
{sql|
SELECT
cache_value
FROM cache
WHERE cache.cache_key = ?
|sql}
|> Caqti_type.(string ->? string)
;;
let find ?ctx key = Sihl.Database.find_opt ?ctx find_request key
let insert_request =
let open Caqti_request.Infix in
{sql|
INSERT INTO cache (
cache_key,
cache_value
) VALUES (
?,
?
)
|sql}
|> Caqti_type.(tup2 string string ->. unit)
;;
let insert ?ctx key_value = Sihl.Database.exec ?ctx insert_request key_value
let update_request =
let open Caqti_request.Infix in
{sql|
UPDATE cache SET
cache_value = $2
WHERE cache_key = $1
|sql}
|> Caqti_type.(tup2 string string ->. unit)
;;
let update ?ctx key_value = Sihl.Database.exec ?ctx update_request key_value
let delete_request =
let open Caqti_request.Infix in
{sql|
DELETE FROM cache
WHERE cache.cache_key = ?
|sql}
|> Caqti_type.(string ->. unit)
;;
let delete ?ctx key = Sihl.Database.exec ?ctx delete_request key
let clean_request =
let open Caqti_request.Infix in
"TRUNCATE TABLE cache" |> Caqti_type.(unit ->. unit)
;;
let clean ?ctx () = Sihl.Database.exec clean_request ?ctx ()
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