fix libraries changes

src/app.ml

@@ -19,12 +19,13 @@ let config_dir =
   | Some config_dir -> config_dir
 
 let config =
-  let filename = Filename.concat config_dir "config.scfg" in
+  let filename = Fpath.add_seg config_dir "config.scfg" in
-  if not @@ Sys.file_exists filename then []
+  let filename_str = Fpath.to_string filename in
+  if not @@ Sys.file_exists filename_str then []
   else begin
-    Dream.log "config file: %s" filename;
+    Dream.log "config file: %s" filename_str;
     match Scfg.Parse.from_file filename with
-    | Error e -> failwith e
+    | Error (`Msg e) -> failwith e
     | Ok config -> config
   end
 
@@ -33,7 +34,7 @@ let open_registration =
   | None -> true
   | Some open_registration -> (
     match Scfg.Query.get_param 0 open_registration with
-    | Error e -> failwith e
+    | Error (`Msg e) -> failwith e
     | Ok "true" -> true
     | Ok "false" -> false
     | Ok _unknown ->
@@ -46,7 +47,7 @@ let port =
   | None -> 8080
   | Some port -> (
     match Scfg.Query.get_param 0 port with
-    | Error e -> failwith e
+    | Error (`Msg e) -> failwith e
     | Ok n -> (
       try
         let n = int_of_string n in
@@ -62,7 +63,10 @@ let hostname =
   match Scfg.Query.get_dir "hostname" config with
   | None -> default_hostname
   | Some hostname ->
-    Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 hostname)
+    Result.fold
+      ~error:(fun (`Msg e) -> failwith e)
+      ~ok:Fun.id
+      (Scfg.Query.get_param 0 hostname)
 
 let () = Dream.log "hostname: %s" hostname
 
@@ -71,7 +75,7 @@ let log =
   | None -> true
   | Some log -> (
     match Scfg.Query.get_param 0 log with
-    | Error e -> failwith e
+    | Error (`Msg e) -> failwith e
     | Ok "true" -> true
     | Ok "false" -> false
     | Ok _unknown -> failwith "invalid `log` value in configuration file" )
@@ -84,7 +88,7 @@ let about =
   | None -> default_about
   | Some about -> (
     match Scfg.Query.get_param 0 about with
-    | Error e -> failwith e
+    | Error (`Msg e) -> failwith e
     | Ok about -> about )
 
 let random_state = Random.State.make_self_init ()

src/db.ml

@@ -3,15 +3,16 @@ open Caqti_request.Infix
 let db_root = App.data_dir
 
 let () =
-  match Bos.OS.Dir.create (Fpath.v db_root) with
+  match Bos.OS.Dir.create db_root with
-  | Ok true -> Dream.log "created %s" db_root
+  | Ok true -> Dream.log "created %s" (Fpath.to_string db_root)
-  | Ok false -> Dream.log "%s already exists" db_root
+  | Ok false -> Dream.log "%s already exists" (Fpath.to_string db_root)
   | Error (`Msg _) ->
-    Dream.warning (fun log -> log "error when creating %s" db_root)
+    Dream.warning (fun log ->
+        log "error when creating %s" (Fpath.to_string db_root) )
 
-let db = Filename.concat db_root (App.App_id.application ^ ".db")
+let db = Fpath.add_seg db_root (App.App_id.application ^ ".db")
 
-let db_uri = Format.sprintf "sqlite3://%s" db
+let db_uri = Format.sprintf "sqlite3://%s" (Fpath.to_string db)
 
 module Db =
   (val Caqti_blocking.connect (Uri.of_string db_uri) |> Caqti_blocking.or_fail)

src/dune

@@ -33,7 +33,8 @@
   tyxml
   tyxml.functor
   uri
-  uuidm)
+  uuidm
+  unix)
  (preprocess
   (pps lwt_ppx)))
 

src/island.ml

@@ -61,8 +61,8 @@ let get request =
   let js =
     script
       ~a:
-        [ a_mime_type "text/javascript"
+        [ (*a_mime_type "text/javascript" ; *)
-        ; a_src "/assets/js/island_client.js"
+          a_src "/assets/js/island_client.js"
         ; a_defer ()
         ]
       (txt "")

src/user.ml

@@ -32,37 +32,36 @@ module Q = struct
 
   let is_already_user =
     Db.find
-    @@ (tup2 string string ->! int)
+    @@ (t2 string string ->! int)
          "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?)"
 
   let upload_user =
     Db.exec
-    @@ (tup4 string string string string ->. unit)
+    @@ (t4 string string string string ->. unit)
          "INSERT INTO user VALUES (?, ?, ?, ?)"
 
   let list_nicks = Db.collect_list @@ (unit ->* string) "SELECT nick FROM user"
 
   let get_user =
     Db.find
-    @@ (string ->! tup4 string string string string)
+    @@ (string ->! t4 string string string string)
          "SELECT * FROM user WHERE user_id=?"
 
   let update_bio =
     Db.exec
-    @@ (tup2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?"
+    @@ (t2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?"
 
   let update_nick =
     Db.exec
-    @@ (tup2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?"
+    @@ (t2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?"
 
   let update_email =
     Db.exec
-    @@ (tup2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?"
+    @@ (t2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?"
 
   let update_password =
     Db.exec
-    @@ (tup2 string string ->. unit)
+    @@ (t2 string string ->. unit) "UPDATE user SET password=? WHERE user_id=?"
-         "UPDATE user SET password=? WHERE user_id=?"
 
   let get_email =
     Db.find @@ (string ->! string) "SELECT email FROM user WHERE user_id=?"
@@ -71,11 +70,11 @@ module Q = struct
     Db.exec @@ (string ->. unit) "DELETE FROM user WHERE user_id=?"
 
   let upload_banished =
-    Db.exec @@ (tup2 string string ->. unit) "INSERT INTO banished VALUES (?,?)"
+    Db.exec @@ (t2 string string ->. unit) "INSERT INTO banished VALUES (?,?)"
 
   let get_banished =
     Db.find
-    @@ (tup2 string string ->! tup2 string string)
+    @@ (t2 string string ->! t2 string string)
          "SELECT * FROM banished WHERE nick=? OR email=?"
 end
 
@@ -102,10 +101,12 @@ let login ~login ~password request =
   let try_password user_id =
     let* good_password = Q.get_password user_id in
     if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then
+      (* TODO lwt
+         await them *)
       let _unit_lwt = Dream.invalidate_session request in
-      let _unit_lwt = Dream.put_session "user_id" user_id request in
+      let _unit_lwt = Dream.set_session_field request "user_id" user_id in
       let* nick = get_nick user_id in
-      let _unit_lwt = Dream.put_session "nick" nick request in
+      let _unit_lwt = Dream.set_session_field request "nick" nick in
       Ok ()
     else if is_banished login then Error (`Forbidden, "YOU ARE BANISHED")
     else Error (`Forbidden, "wrong password")
@@ -157,12 +158,12 @@ let list () =
          | s -> Format.fprintf fmt {|<li><a href="/user/%s">%s</a></li>|} s s ))
        users )
 
-let get_nick_unsafe request = Option.get @@ Dream.session "nick" request
+let get_nick_unsafe request = Option.get @@ Dream.session_field request "nick"
 
-let is_logged_in request = Option.is_some @@ Dream.session "nick" request
+let is_logged_in request = Option.is_some @@ Dream.session_field request "nick"
 
 let profile request =
-  match Dream.session "nick" request with
+  match Dream.session_field request "nick" with
   | None -> "not logged in"
   | Some nick -> Format.sprintf "Hello %s !" nick
 

src/ws.ml

@@ -7,7 +7,7 @@ let get_state_unsafe user_id =
   | Ok state -> state
 
 let handle_client request client =
-  match Dream.session "user_id" request with
+  match Dream.session_field request "user_id" with
   | None -> Dream.log "User does not exists" |> Lwt.return
   | Some user_id ->
     (* send user island state for the first time *)