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
This commit is contained in:
Joey Hess 2023-12-26 18:31:52 -04:00
parent 6d789c9c81
commit 8a3beabf35
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 138 additions and 8 deletions

99
Database/RawFilePath.hs Normal file
View file

@ -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