b

src/db.ml

@@ -0,0 +1,48 @@
+open Caqti_request.Infix
+
+let db_root = App.data_dir
+
+let () =
+  match Bos.OS.Dir.create (Fpath.v db_root) with
+  | Ok true -> Dream.log "created %s" db_root
+  | Ok false -> Dream.log "%s already exists" db_root
+  | Error (`Msg _) ->
+    Dream.warning (fun log -> log "error when creating %s" db_root)
+
+let db = Filename.concat db_root (App.App_id.application ^ ".db")
+
+let db_uri = Format.sprintf "sqlite3://%s" db
+
+module Db =
+  (val Caqti_blocking.connect (Uri.of_string db_uri) |> Caqti_blocking.or_fail)
+
+let () =
+  let set_foreign_keys_on =
+    Caqti_type.(unit ->. unit) "PRAGMA foreign_keys = ON"
+  in
+  if Result.is_error (Db.exec set_foreign_keys_on ()) then
+    Dream.error (fun log -> log "can't set foreign_keys on")
+
+let () =
+  let query =
+    Caqti_type.(unit ->. unit)
+      "CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \
+       TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL)"
+  in
+  match Db.exec query () with
+  | Ok () -> ()
+  | Error _e ->
+    Format.eprintf "db error@\n";
+    exit 1
+
+let unwrap_err = function
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+  | Ok _ as ok -> ok
+
+let exec q v = Db.exec q v |> unwrap_err
+
+let find q v = Db.find q v |> unwrap_err
+
+let find_opt q v = Db.find_opt q v |> unwrap_err
+
+let collect_list q v = Db.collect_list q v |> unwrap_err