package sihl-cache

  1. Overview
  2. Docs

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
151
152
153
154
155
156
157
158
159
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

(* 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 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 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