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:
parent
6d789c9c81
commit
8a3beabf35
8 changed files with 138 additions and 8 deletions
99
Database/RawFilePath.hs
Normal file
99
Database/RawFilePath.hs
Normal 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
|
Loading…
Add table
Add a link
Reference in a new issue