Caqti-requests fixed according to updated version of Caqti

klausnat · Feb 8, 2023 · 73a87fb · 73a87fb
1 parent 2386083
commit 73a87fb
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 10 deletions.
diff --git a/src/sql/session.ml b/src/sql/session.ml
@@ -4,7 +4,7 @@
    Copyright 2021 Anton Bachin *)
 
 
-
+open Caqti_request.Infix
 module Dream = Dream_pure
 module Cookie = Dream__server.Cookie
 module Session = Dream__server.Session
@@ -25,12 +25,30 @@ let serialize_payload payload =
   |> fun assoc -> `Assoc assoc
   |> Yojson.Basic.to_string
 
+(*
+let foreign_keys_on =
+ Caqti_type.unit ->. Caqti_type.unit @@
+    {eos|
+      PRAGMA foreign_keys = ON
+    |eos} 
+
+let foreign_keys_on =
+  Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON"
+
+*)
+
 let insert =
+(*
   let query =
     R.exec T.(tup4 string string float string) {|
       INSERT INTO dream_session (id, label, expires_at, payload)
       VALUES ($1, $2, $3, $4)
-    |} in
+    |} *)
+  let query = T.(tup4 string string float string) ->. T.unit @@
+    {eos|
+      INSERT INTO dream_session (id, label, expires_at, payload)
+      VALUES ($1, $2, $3, $4)
+    |eos} in
 
   fun (module Db : DB) (session : Session.session) ->
     let payload = serialize_payload session.payload in
@@ -39,9 +57,13 @@ let insert =
     Caqti_lwt.or_fail result
 
 let find_opt =
-  let query =
+  let query = T.string ->? T.(tup3 string float string) @@
+    {eos|
+      SELECT label, expires_at, payload FROM dream_session WHERE id = $1
+    |eos} in
+(*  let query =   
     R.find_opt T.string T.(tup3 string float string)
-      "SELECT label, expires_at, payload FROM dream_session WHERE id = $1" in
+      "SELECT label, expires_at, payload FROM dream_session WHERE id = $1" in *)
 
   fun (module Db : DB) id ->
     let%lwt result = Db.find_opt query id in
@@ -67,25 +89,31 @@ let find_opt =
 
 let refresh =
   let query =
-    R.exec T.(tup2 float string)
-      "UPDATE dream_session SET expires_at = $1 WHERE id = $2" in
+    T.(tup2 float string) ->. T.unit @@
+    {eos|
+      UPDATE dream_session SET expires_at = $1 WHERE id = $2
+    |eos} in
 
   fun (module Db : DB) (session : Session.session) ->
     let%lwt result = Db.exec query (session.expires_at, session.id) in
     Caqti_lwt.or_fail result
 
 let update =
   let query =
-    R.exec T.(tup2 string string)
-      "UPDATE dream_session SET payload = $1 WHERE id = $2" in
+    T.(tup2 string string) ->. T.unit @@
+    {eos|
+      UPDATE dream_session SET payload = $1 WHERE id = $2
+    |eos} in
 
   fun (module Db : DB) (session : Session.session) ->
     let payload = serialize_payload session.payload in
     let%lwt result = Db.exec query (payload, session.id) in
     Caqti_lwt.or_fail result
 
 let remove =
-  let query = R.exec T.string "DELETE FROM dream_session WHERE id = $1" in
+  let query = T.string ->. T.unit @@
+    {eos| DELETE FROM dream_session WHERE id = $1
+    |eos} in
 
   fun (module Db : DB) id ->
     let%lwt result = Db.exec query id in

diff --git a/src/sql/sql.ml b/src/sql/sql.ml
@@ -4,7 +4,7 @@
    Copyright 2021 Anton Bachin *)
 
 
-
+open Caqti_request.Infix
 module Log = Dream__server.Log
 module Message = Dream_pure.Message
 
@@ -17,8 +17,15 @@ let log =
 let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Message.field =
   Message.new_field ()
 
+let foreign_keys_on =
+ Caqti_type.unit ->. Caqti_type.unit @@
+    {eos|
+      PRAGMA foreign_keys = ON
+    |eos}
+(*
 let foreign_keys_on =
   Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON"
+*)
 
 let post_connect (module Db : Caqti_lwt.CONNECTION) =
   match Caqti_driver_info.dialect_tag Db.driver_info with