From 94ea84354715c4a2bb30cd4aaeaaba506358d1d6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 31 May 2019 09:58:37 -0400
Subject: Filecache support for MySQL

---
 src/c/urweb.c     | 5 ++---
 src/cjr_print.sml | 2 +-
 src/filecache.sml | 5 ++++-
 src/mysql.sml     | 3 ++-
 src/postgres.sml  | 3 ++-
 src/settings.sig  | 8 +++++---
 src/settings.sml  | 2 +-
 7 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 4d9e8630..8a7c439a 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -5327,9 +5327,8 @@ uw_Basis_blob uw_Basis_check_filecache(uw_context ctx, uw_Basis_string hash) {
 
   // Hashes come formatted for printing by Postgres, which means they start with
   // two extra characters.  Let's remove them.
-  if (!hash[0] || !hash[1])
-    uw_error(ctx, FATAL, "Hash to check against file cache came in not in Postgres format: %s", hash);
-  hash += 2;
+  if (hash[0] == '\\' && hash[1] == 'x')
+    hash += 2;
 
   if (!dir)
     uw_error(ctx, FATAL, "Checking file cache when no directory is set");
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 1e948943..4aa8d51e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3827,7 +3827,7 @@ fun p_sql env (ds, _) =
                 | SOME _ => case #supportsSHA512 (Settings.currentDbms ()) of
                                 NONE => (ErrorMsg.error "Using file cache with database that doesn't support SHA512";
                                          [])
-                              | SOME line => [string line, newline, newline])
+                              | SOME r => [string (#InitializeDb r), newline, newline])
              @ string (#sqlPrefix (Settings.currentDbms ())) :: pps)
     end
 
diff --git a/src/filecache.sml b/src/filecache.sml
index e2291c10..a0da4b05 100644
--- a/src/filecache.sml
+++ b/src/filecache.sml
@@ -81,7 +81,10 @@ fun instrument file =
                         fun wrapCol (name, t) =
                             case #1 t of
                                 TFfi ("Basis", "blob") =>
-                                "DIGEST(" ^ name ^ ", 'sha512')"
+                                (case #supportsSHA512 (Settings.currentDbms ()) of
+                                     NONE => (ErrorMsg.error "DBMS doesn't support SHA512.";
+                                              "ERROR")
+                                   | SOME r => #GenerateHash r name)
                               | TOption t' => wrapCol (name, t')
                               | _ => name
 
diff --git a/src/mysql.sml b/src/mysql.sml
index 768c5441..a826f3ef 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1610,6 +1610,7 @@ val () = addDbms {name = "mysql",
                   nestedRelops = false,
                   windowFunctions = false,
                   supportsIsDistinctFrom = true,
-                  supportsSHA512 = NONE}
+                  supportsSHA512 = SOME {InitializeDb = "",
+                                         GenerateHash = fn name => "SHA2(" ^ name ^ ", 512)"}}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index a33a1de4..2b0a710d 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -1154,7 +1154,8 @@ val () = addDbms {name = "postgres",
                   nestedRelops = true,
                   windowFunctions = true,
                   supportsIsDistinctFrom = true,
-                  supportsSHA512 = SOME "CREATE EXTENSION pgcrypto;"}
+                  supportsSHA512 = SOME {InitializeDb = "CREATE EXTENSION pgcrypto;",
+                                         GenerateHash = fn name => "DIGEST(" ^ name ^ ", 'sha512')"}}
 
 val () = setDbms "postgres"
 
diff --git a/src/settings.sig b/src/settings.sig
index 97d56b45..7ca7a0cd 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -222,9 +222,11 @@ signature SETTINGS = sig
          nestedRelops : bool,
          windowFunctions : bool,
          supportsIsDistinctFrom : bool,
-         supportsSHA512 : string option (* If supported, give the SQL code to
-                                         * enable the feature in a particular
-                                         * database. *)
+         supportsSHA512 : {InitializeDb : string,
+                           GenerateHash : string -> string} option
+         (* If supported, give the SQL code to
+          * enable the feature in a particular
+          * database and to compute a hash of a value. *)
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index ac403027..a31f5cda 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -652,7 +652,7 @@ type dbms = {
      nestedRelops : bool,
      windowFunctions: bool,
      supportsIsDistinctFrom : bool,
-     supportsSHA512 : string option
+     supportsSHA512 : {InitializeDb : string, GenerateHash : string -> string} option
 }
 
 val dbmses = ref ([] : dbms list)
-- 
cgit v1.2.3