Source file repo_sql.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
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

(* Common functions that are shared by SQL implementations *)

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 ?ctx key = Sihl.Database.find_opt ?ctx find_request key

let insert_request =
  Caqti_request.exec
    Caqti_type.(tup2 string string)
    {sql|
        INSERT INTO cache (
          cache_key,
          cache_value
        ) VALUES (
          ?,
          ?
        )
        |sql}
;;

let insert ?ctx key_value = Sihl.Database.exec ?ctx insert_request key_value

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 ?ctx key_value = Sihl.Database.exec ?ctx update_request key_value

let delete_request =
  Caqti_request.exec
    Caqti_type.string
    {sql|
      DELETE FROM cache 
      WHERE cache.cache_key = ?
      |sql}
;;

let delete ?ctx key = Sihl.Database.exec ?ctx delete_request key
let clean_request = Caqti_request.exec Caqti_type.unit "TRUNCATE TABLE cache;"
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