use RawFilePath for opening sqlite databases

Fix a crash opening sqlite databases when run in a non-unicode locale,
with a remote that uses a non-unicode filepath. In that situation
converting to Text fails.

The fix needs git-annex to be built with persistent-sqlite 2.13.3.
Building against older versions still works, but that version is used when
building with stack.

Database.RawFilePath is a lot of code copied from persistent-sqlite and
lightly modified, since only 1 function in persistent-sqlite was made to
support RawFilePath. This is a bit of a pain, and I hope that
persistent-sqlite will eventually switch to using OsPath, allowing this
module to be removed from git-annex.

Sponsored-by: k0ld on Patreon

CHANGELOG

@@ -25,6 +25,8 @@ git-annex (10.20231130) UNRELEASED; urgency=medium
     filesystems that have problems with such filenames.
   * sync, push: Avoid trying to send individual files to special remotes
     configured with importtree=yes exporttree=no, which would always fail.
+  * Fix a crash opening sqlite databases when run in a non-unicode locale.
+    (Needs persistent-sqlite 2.13.3.)
 
  -- Joey Hess <id@joeyh.name>  Thu, 30 Nov 2023 14:48:12 -0400
 

COPYRIGHT

@@ -64,6 +64,12 @@ License: GPL-2
  The full text of version 2 of the GPL is distributed in
  /usr/share/common-licenses/GPL-2 on Debian systems.
 
+Files: Database/RawFilePath.hs
+Copyright: © 2012 Michael Snoyman, http://www.yesodweb.com/
+           © 2023 Joey Hess <id@joeyh.name>
+License: Expat
+ The text of the Expat license is in the Expat section below.
+
 Files: doc/tips/automatically_adding_metadata/pre-commit-annex 
 Copyright: 2014 Joey Hess <id@joeyh.name>
            2016 Klaus Ethgen <Klaus@Ethgen.ch>

Database/ContentIdentifier.hs

@@ -53,9 +53,14 @@ import qualified Utility.RawFilePath as R
 
 import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
-import Database.Persist.Sqlite (runSqlite)
 import qualified System.FilePath.ByteString as P
+
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+import Database.RawFilePath
+#else
+import Database.Persist.Sqlite (runSqlite)
 import qualified Data.Text as T
+#endif
 
 data ContentIdentifierHandle = ContentIdentifierHandle H.DbQueue Bool
 
@@ -102,8 +107,13 @@ openDb = do
 			runMigrationSilent migrateContentIdentifier
 		-- Migrate from old versions of database, which had buggy
 		-- and suboptimal uniqueness constraints.
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+		else liftIO $ runSqlite' db $ void $
+			runMigrationSilent migrateContentIdentifier
+#else
 		else liftIO $ runSqlite (T.pack (fromRawFilePath db)) $ void $
 			runMigrationSilent migrateContentIdentifier
+#endif
 	h <- liftIO $ H.openDbQueue db "content_identifiers"
 	return $ ContentIdentifierHandle h isnew
 

Database/Handle.hs

@@ -193,11 +193,13 @@ runSqliteRobustly tablename db a = do
 				| otherwise -> rethrow $ errmsg "after successful open" ex
 	
 	opensettle retries ic = do
-		conn <- Sqlite.open tdb
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+		conn <- Sqlite.open' db
+#else
+		conn <- Sqlite.open (T.pack (fromRawFilePath db))
+#endif
 		settle conn retries ic
 
-	tdb = T.pack (fromRawFilePath db)
-
 	settle conn retries ic = do
 		r <- try $ do
 			stmt <- Sqlite.prepare conn nullselect

Database/Init.hs

@@ -1,11 +1,11 @@
 {- Persistent sqlite database initialization
  -
- - Copyright 2015-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, CPP #-}
 
 module Database.Init where
 
@@ -13,6 +13,9 @@ import Annex.Common
 import Annex.Perms
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+import Database.RawFilePath
+#endif
 
 import Database.Persist.Sqlite
 import Lens.Micro
@@ -32,9 +35,13 @@ initDb db migration = do
 	let dbdir = P.takeDirectory db
 	let tmpdbdir = dbdir <> ".tmp"
 	let tmpdb = tmpdbdir P.</> "db"
-	let tdb = T.pack (fromRawFilePath tmpdb)
+	let tmpdb' = T.pack (fromRawFilePath tmpdb)
 	createAnnexDirectory tmpdbdir
-	liftIO $ runSqliteInfo (enableWAL tdb) migration
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+	liftIO $ runSqliteInfo' tmpdb (enableWAL tmpdb') migration
+#else
+	liftIO $ runSqliteInfo (enableWAL tmpdb') migration
+#endif
 	setAnnexDirPerm tmpdbdir
 	-- Work around sqlite bug that prevents it from honoring
 	-- less restrictive umasks.

Database/RawFilePath.hs

@@ -0,0 +1,99 @@
+{- Persistent sqlite RawFilePath support
+ -
+ - The functions below are copied from persistent-sqlite, but modified to
+ - take a RawFilePath and ignore the sqlConnectionStr from the
+ - SqliteConnectionInfo. This avoids encoding problems using Text
+ - in some situations.
+ -
+ - This module is expected to eventually be supersceded by
+ - persistent-sqlite getting support for OsString.
+ -
+ - Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
+ - Copyright 2023 Joey Hess <id@joeyh.name>
+ -
+ - Permission is hereby granted, free of charge, to any person obtaining
+ - a copy of this software and associated documentation files (the
+ - "Software"), to deal in the Software without restriction, including
+ - without limitation the rights to use, copy, modify, merge, publish,
+ - distribute, sublicense, and/or sell copies of the Software, and to
+ - permit persons to whom the Software is furnished to do so, subject to
+ - the following conditions:
+ - 
+ - The above copyright notice and this permission notice shall be
+ - included in all copies or substantial portions of the Software.
+ - 
+ - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ - EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ - MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ - NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+ - LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+ - OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+ - WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+-}
+
+{-# LANGUAGE OverloadedStrings, CPP #-}
+
+module Database.RawFilePath where
+
+import Database.Persist.Sqlite
+import qualified Database.Sqlite as Sqlite
+import qualified System.FilePath.ByteString as P
+import qualified Control.Exception as E
+import Control.Monad.Logger (MonadLoggerIO)
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
+import UnliftIO.Resource (ResourceT, runResourceT)
+
+{- The functions below are copied from persistent-sqlite, but modified to
+ - take a RawFilePath and ignore the sqlConnectionStr from the
+ - SqliteConnectionInfo. This avoids encoding problems using Text
+ - in some situations. -}
+#if MIN_VERSION_persistent_sqlite(2,13,3)
+openWith'
+	:: P.RawFilePath 
+	-> (SqlBackend -> Sqlite.Connection -> r)
+	-> SqliteConnectionInfo
+	-> LogFunc
+	-> IO r
+openWith' db f connInfo logFunc = do
+	conn <- Sqlite.open' db
+	backend <- wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn
+	return $ f backend conn
+
+runSqlite' :: (MonadUnliftIO m)
+	=> P.RawFilePath
+	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
+	-> m a
+runSqlite' connstr = runResourceT
+	. runNoLoggingT
+	. withSqliteConn' connstr
+	. runSqlConn
+
+withSqliteConn'
+	:: (MonadUnliftIO m, MonadLoggerIO m)
+	=> P.RawFilePath
+	-> (SqlBackend -> m a)
+	-> m a
+withSqliteConn' connstr = withSqliteConnInfo' connstr $
+	mkSqliteConnectionInfo mempty
+
+runSqliteInfo'
+	:: (MonadUnliftIO m)
+	=> P.RawFilePath
+	-> SqliteConnectionInfo
+	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
+	-> m a
+runSqliteInfo' db conInfo = runResourceT
+	. runNoLoggingT
+	. withSqliteConnInfo' db conInfo
+	. runSqlConn
+
+withSqliteConnInfo'
+	:: (MonadUnliftIO m, MonadLoggerIO m)
+        => P.RawFilePath
+	-> SqliteConnectionInfo
+	-> (SqlBackend -> m a)
+	-> m a
+withSqliteConnInfo' db = withSqlConn . openWith' db const
+#endif

doc/bugs/SQlite_failed_when_copying_to_remote_repository.mdwn

@@ -77,3 +77,6 @@ I use git-annex for several years, and I'm very happy with it. I's one of the be
 
 
 [[!meta title="sqlite fails when repository path contains non-unicode"]]
+
+> [[fixed|done]], when git-annex is built against persistent-sqlite version
+> 2.13.3. --[[Joey]]

git-annex.cabal

@@ -746,6 +746,7 @@ Executable git-annex
     Database.Keys.Tables
     Database.Keys.SQL
     Database.Queue
+    Database.RawFilePath
     Database.Types
     Database.Utility
     Git