Hello community,
here is the log from the commit of package ghc-persistent-sqlite for openSUSE:Factory checked in at 2019-04-28 20:13:23
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent-sqlite (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.5536 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-sqlite"
Sun Apr 28 20:13:23 2019 rev:14 rq:698557 version:2.10.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-persistent-sqlite/ghc-persistent-sqlite.changes 2019-01-25 22:43:29.599218736 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.5536/ghc-persistent-sqlite.changes 2019-04-28 20:13:25.810419346 +0200
@@ -1,0 +2,18 @@
+Sat Apr 20 09:17:16 UTC 2019 - psimons@suse.com
+
+- Update persistent-sqlite to version 2.10.0.
+ ## 2.10.0
+
+ * Updated for `persistent-2.10.0` compatibility.
+
+-------------------------------------------------------------------
+Mon Apr 8 02:02:01 UTC 2019 - psimons@suse.com
+
+- Update persistent-sqlite to version 2.9.3.
+ ## 2.9.3
+
+ * Add retry-on-busy support, automatically retrying when sqlite returns a busy
+ error on enabling WAL mode, and providing helper `retryOnBusy` and
+ `waitForDatabase` identifiers.
+
+-------------------------------------------------------------------
Old:
----
persistent-sqlite-2.9.2.tar.gz
New:
----
persistent-sqlite-2.10.0.tar.gz
persistent-sqlite.cabal
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-sqlite.spec ++++++
--- /var/tmp/diff_new_pack.RnPU5N/_old 2019-04-28 20:13:28.766417508 +0200
+++ /var/tmp/diff_new_pack.RnPU5N/_new 2019-04-28 20:13:28.770417506 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-persistent-sqlite
#
-# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,13 +19,14 @@
%global pkg_name persistent-sqlite
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.9.2
+Version: 2.10.0
Release: 0
Summary: Backend for the persistent library using sqlite3
License: MIT
Group: Development/Libraries/Haskell
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
+Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-bytestring-devel
@@ -33,7 +34,6 @@
BuildRequires: ghc-containers-devel
BuildRequires: ghc-microlens-th-devel
BuildRequires: ghc-monad-logger-devel
-BuildRequires: ghc-old-locale-devel
BuildRequires: ghc-persistent-devel
BuildRequires: ghc-resource-pool-devel
BuildRequires: ghc-resourcet-devel
@@ -46,8 +46,15 @@
BuildRequires: glibc-devel
BuildRequires: sqlite3-devel
%if %{with tests}
+BuildRequires: ghc-HUnit-devel
+BuildRequires: ghc-QuickCheck-devel
+BuildRequires: ghc-exceptions-devel
+BuildRequires: ghc-fast-logger-devel
BuildRequires: ghc-hspec-devel
BuildRequires: ghc-persistent-template-devel
+BuildRequires: ghc-persistent-test-devel
+BuildRequires: ghc-system-fileio-devel
+BuildRequires: ghc-system-filepath-devel
BuildRequires: ghc-temporary-devel
%endif
@@ -71,9 +78,10 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cabal-tweak-flag systemlib True
+cp -p %{SOURCE1} %{pkg_name}.cabal
%build
+%define cabal_configure_options -fsystemlib
%ghc_lib_build
%install
++++++ persistent-sqlite-2.9.2.tar.gz -> persistent-sqlite-2.10.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-sqlite-2.9.2/ChangeLog.md new/persistent-sqlite-2.10.0/ChangeLog.md
--- old/persistent-sqlite-2.9.2/ChangeLog.md 2018-12-30 05:47:05.000000000 +0100
+++ new/persistent-sqlite-2.10.0/ChangeLog.md 2019-04-19 02:00:28.000000000 +0200
@@ -1,5 +1,15 @@
# Changelog for persistent-sqlite
+## 2.10.0
+
+* Updated for `persistent-2.10.0` compatibility.
+
+## 2.9.3
+
+* Add retry-on-busy support, automatically retrying when sqlite returns a busy
+ error on enabling WAL mode, and providing helper `retryOnBusy` and
+ `waitForDatabase` identifiers.
+
## 2.9.2
* Add enableExtendedResultCodes and disableExtendedResultCodes functions
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Persist/Sqlite.hs new/persistent-sqlite-2.10.0/Database/Persist/Sqlite.hs
--- old/persistent-sqlite-2.9.2/Database/Persist/Sqlite.hs 2018-12-30 02:20:10.000000000 +0100
+++ new/persistent-sqlite-2.10.0/Database/Persist/Sqlite.hs 2019-04-19 02:00:43.000000000 +0200
@@ -1,11 +1,10 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
-- | A sqlite backend for persistent.
--
-- Note: If you prepend @WAL=off @ to your connection string, it will disable
@@ -30,21 +29,16 @@
, wrapConnection
, wrapConnectionInfo
, mockMigration
+ , retryOnBusy
+ , waitForDatabase
) where
-import Database.Persist.Sql
-import Database.Persist.Sql.Types.Internal (mkPersistBackend)
-import qualified Database.Persist.Sql.Util as Util
-
-import qualified Database.Sqlite as Sqlite
-
-import Control.Applicative as A
+import Control.Concurrent (threadDelay)
import qualified Control.Exception as E
import Control.Monad (forM_)
-import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withUnliftIO, unliftIO)
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger)
+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withUnliftIO, unliftIO, withRunInIO)
+import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger, logWarn, runLoggingT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
-import UnliftIO.Resource (ResourceT, runResourceT)
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Aeson
@@ -61,14 +55,21 @@
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Lens.Micro.TH (makeLenses)
+import UnliftIO.Resource (ResourceT, runResourceT)
+
+import Database.Persist.Sql
+import Database.Persist.Sql.Types.Internal (mkPersistBackend)
+import qualified Database.Persist.Sql.Util as Util
+import qualified Database.Sqlite as Sqlite
+
-- | Create a pool of SQLite connections.
--
-- Note that this should not be used with the @:memory:@ connection string, as
-- the pool will regularly remove connections, destroying your database.
-- Instead, use 'withSqliteConn'.
-createSqlitePool :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend)
- => Text -> Int -> m (Pool backend)
+createSqlitePool :: (MonadLogger m, MonadUnliftIO m)
+ => Text -> Int -> m (Pool SqlBackend)
createSqlitePool = createSqlitePoolFromInfo . conStringToInfo
-- | Create a pool of SQLite connections.
@@ -78,17 +79,17 @@
-- Instead, use 'withSqliteConn'.
--
-- @since 2.6.2
-createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend)
- => SqliteConnectionInfo -> Int -> m (Pool backend)
+createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)
+ => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo connInfo = createSqlPool $ open' connInfo
-- | Run the given action with a connection pool.
--
-- Like 'createSqlitePool', this should not be used with @:memory:@.
-withSqlitePool :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
+withSqlitePool :: (MonadUnliftIO m, MonadLogger m)
=> Text
-> Int -- ^ number of connections to open
- -> (Pool backend -> m a) -> m a
+ -> (Pool SqlBackend -> m a) -> m a
withSqlitePool connInfo = withSqlPool . open' $ conStringToInfo connInfo
-- | Run the given action with a connection pool.
@@ -96,22 +97,22 @@
-- Like 'createSqlitePool', this should not be used with @:memory:@.
--
-- @since 2.6.2
-withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => SqliteConnectionInfo
- -> Int -- ^ number of connections to open
- -> (Pool backend -> m a) -> m a
+withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo
+ -> Int -- ^ number of connections to open
+ -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo connInfo = withSqlPool $ open' connInfo
-withSqliteConn :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => Text -> (backend -> m a) -> m a
+withSqliteConn :: (MonadUnliftIO m, MonadLogger m)
+ => Text -> (SqlBackend -> m a) -> m a
withSqliteConn = withSqliteConnInfo . conStringToInfo
-- | @since 2.6.2
-withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => SqliteConnectionInfo -> (backend -> m a) -> m a
+withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo = withSqlConn . open'
-open' :: (IsSqlBackend backend) => SqliteConnectionInfo -> LogFunc -> IO backend
+open' :: SqliteConnectionInfo -> LogFunc -> IO SqlBackend
open' connInfo logFunc = do
conn <- Sqlite.open $ _sqlConnectionStr connInfo
wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn
@@ -128,20 +129,20 @@
-- > {-# LANGUAGE TemplateHaskell #-}
-- > {-# LANGUAGE QuasiQuotes #-}
-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
--- >
+-- >
-- > import Control.Monad.IO.Class (liftIO)
-- > import Database.Persist
-- > import Database.Sqlite
-- > import Database.Persist.Sqlite
-- > import Database.Persist.TH
--- >
+-- >
-- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-- > Person
-- > name String
-- > age Int Maybe
-- > deriving Show
-- > |]
--- >
+-- >
-- > main :: IO ()
-- > main = do
-- > conn <- open "/home/sibi/test.db"
@@ -158,46 +159,80 @@
--
-- > Migrating: CREATE TABLE "person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL)
-- > [Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = Person {personName = "John doe", personAge = Just 35}},Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = Person {personName = "Hema", personAge = Just 36}}]
---
+--
-- @since 1.1.5
-wrapConnection :: (IsSqlBackend backend) => Sqlite.Connection -> LogFunc -> IO backend
+wrapConnection :: Sqlite.Connection -> LogFunc -> IO SqlBackend
wrapConnection = wrapConnectionInfo (mkSqliteConnectionInfo "")
+-- | Retry if a Busy is thrown, following an exponential backoff strategy.
+--
+-- @since 2.9.3
+retryOnBusy :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
+retryOnBusy action =
+ start $ take 20 $ delays 1000
+ where
+ delays x
+ | x >= 1000000 = repeat x
+ | otherwise = x : delays (x * 2)
+
+ start [] = do
+ $logWarn "Out of retry attempts"
+ action
+ start (x:xs) = do
+ -- Using try instead of catch to avoid creating a stack overflow
+ eres <- withRunInIO $ \run -> E.try $ run action
+ case eres of
+ Left (Sqlite.SqliteException { Sqlite.seError = Sqlite.ErrorBusy }) -> do
+ $logWarn "Encountered an SQLITE_BUSY, going to retry..."
+ liftIO $ threadDelay x
+ start xs
+ Left e -> liftIO $ E.throwIO e
+ Right y -> return y
+
+-- | Wait until some noop action on the database does not return an 'Sqlite.ErrorBusy'. See 'retryOnBusy'.
+--
+-- @since 2.9.3
+waitForDatabase
+ :: (MonadUnliftIO m, MonadLogger m, BackendCompatible SqlBackend backend)
+ => ReaderT backend m ()
+waitForDatabase = retryOnBusy $ rawExecute "SELECT 42" []
+
-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL
-- 'Connection', allowing full control over WAL and FK constraints.
--
-- @since 2.6.2
-wrapConnectionInfo :: (IsSqlBackend backend)
- => SqliteConnectionInfo
- -> Sqlite.Connection
- -> LogFunc
- -> IO backend
+wrapConnectionInfo
+ :: SqliteConnectionInfo
+ -> Sqlite.Connection
+ -> LogFunc
+ -> IO SqlBackend
wrapConnectionInfo connInfo conn logFunc = do
let
-- Turn on the write-ahead log
-- https://github.com/yesodweb/persistent/issues/363
walPragma
- | _walEnabled connInfo = ("PRAGMA journal_mode=WAL;":)
+ | _walEnabled connInfo = (("PRAGMA journal_mode=WAL;", True):)
| otherwise = id
-- Turn on foreign key constraints
-- https://github.com/yesodweb/persistent/issues/646
fkPragma
- | _fkEnabled connInfo = ("PRAGMA foreign_keys = on;":)
+ | _fkEnabled connInfo = (("PRAGMA foreign_keys = on;", False):)
| otherwise = id
-- Allow arbitrary additional pragmas to be set
-- https://github.com/commercialhaskell/stack/issues/4247
- pragmas = walPragma $ fkPragma $ _extraPragmas connInfo
+ pragmas = walPragma $ fkPragma $ map (, False) $ _extraPragmas connInfo
- forM_ pragmas $ \pragma -> do
+ forM_ pragmas $ \(pragma, shouldRetry) -> flip runLoggingT logFunc $
+ (if shouldRetry then retryOnBusy else id) $ liftIO $ do
stmt <- Sqlite.prepare conn pragma
_ <- Sqlite.stepConn conn stmt
Sqlite.reset conn stmt
Sqlite.finalize stmt
smap <- newIORef $ Map.empty
- return . mkPersistBackend $ SqlBackend
+ return $ SqlBackend
{ connPrepare = prepare' conn
, connStmtMap = smap
, connInsertSql = insertSql'
@@ -229,9 +264,9 @@
-- that all log messages are discarded.
--
-- @since 1.1.4
-runSqlite :: (MonadUnliftIO m, IsSqlBackend backend)
+runSqlite :: (MonadUnliftIO m)
=> Text -- ^ connection string
- -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database action
+ -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database action
-> m a
runSqlite connstr = runResourceT
. runNoLoggingT
@@ -243,9 +278,9 @@
-- that all log messages are discarded.
--
-- @since 2.6.2
-runSqliteInfo :: (MonadUnliftIO m, IsSqlBackend backend)
+runSqliteInfo :: (MonadUnliftIO m)
=> SqliteConnectionInfo
- -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database action
+ -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database action
-> m a
runSqliteInfo conInfo = runResourceT
. runNoLoggingT
@@ -590,11 +625,11 @@
parseJSON v = modifyFailure ("Persistent: error loading Sqlite conf: " ++) $ flip (withObject "SqliteConf") v parser where
parser o = if HashMap.member "database" o
then SqliteConf
- A.<$> o .: "database"
- A.<*> o .: "poolsize"
+ <$> o .: "database"
+ <*> o .: "poolsize"
else SqliteConfInfo
- A.<$> o .: "connInfo"
- A.<*> o .: "poolsize"
+ <$> o .: "connInfo"
+ <*> o .: "poolsize"
instance PersistConfig SqliteConf where
type PersistConfigBackend SqliteConf = SqlPersistT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Sqlite.hs new/persistent-sqlite-2.10.0/Database/Sqlite.hs
--- old/persistent-sqlite-2.9.2/Database/Sqlite.hs 2018-12-30 05:47:05.000000000 +0100
+++ new/persistent-sqlite-2.10.0/Database/Sqlite.hs 2019-04-15 04:27:15.000000000 +0200
@@ -1,6 +1,6 @@
-{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-- | A port of the direct-sqlite package for dealing directly with
-- 'PersistValue's.
module Database.Sqlite (
@@ -8,8 +8,7 @@
Statement,
Error(..),
SqliteException(..),
- StepResult(Row,
- Done),
+ StepResult(Row, Done),
Config(ConfigLogFn),
LogFunction,
SqliteStatus (..),
@@ -81,29 +80,24 @@
import Prelude hiding (error)
import qualified Prelude as P
-import qualified Prelude
+
+import Control.Exception (Exception, throwIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU
import qualified Data.ByteString.Internal as BSI
-import Foreign
-import Foreign.C
-import Control.Exception (Exception, throwIO)
-import Control.Applicative as A ((<$>))
-import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
+import Data.Fixed (Pico)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Monoid (mappend, mconcat)
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
-import Data.Monoid (mappend, mconcat)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Fixed (Pico)
-import Data.Time (formatTime, UTCTime)
+import Data.Time (defaultTimeLocale, formatTime, UTCTime)
import Data.Typeable (Typeable)
+import Foreign
+import Foreign.C
+
+import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
-#if MIN_VERSION_time(1,5,0)
-import Data.Time (defaultTimeLocale)
-#else
-import System.Locale (defaultTimeLocale)
-#endif
data Connection = Connection !(IORef Bool) Connection'
newtype Connection' = Connection' (Ptr ())
@@ -198,7 +192,7 @@
decodeError 26 = ErrorNotAConnection
decodeError 100 = ErrorRow
decodeError 101 = ErrorDone
-decodeError i = Prelude.error $ "decodeError " ++ show i
+decodeError i = P.error $ "decodeError " ++ show i
decodeColumnType :: Int -> ColumnType
decodeColumnType 1 = IntegerColumn
@@ -206,7 +200,7 @@
decodeColumnType 3 = TextColumn
decodeColumnType 4 = BlobColumn
decodeColumnType 5 = NullColumn
-decodeColumnType i = Prelude.error $ "decodeColumnType " ++ show i
+decodeColumnType i = P.error $ "decodeColumnType " ++ show i
foreign import ccall "sqlite3_errmsg"
errmsgC :: Ptr () -> IO CString
@@ -236,7 +230,7 @@
openError path' = do
let flag = sqliteFlagReadWrite .|. sqliteFlagCreate .|. sqliteFlagUri
BS.useAsCString (encodeUtf8 path') $ \path -> alloca $ \database -> do
- err <- decodeError A.<$> openC path database flag nullPtr
+ err <- decodeError <$> openC path database flag nullPtr
case err of
ErrorOK -> do database' <- peek database
active <- newIORef True
@@ -480,6 +474,7 @@
PersistList l -> bindText statement parameterIndex $ listToJSON l
PersistMap m -> bindText statement parameterIndex $ mapToJSON m
PersistDbSpecific s -> bindText statement parameterIndex $ decodeUtf8With lenientDecode s
+ PersistArray a -> bindText statement parameterIndex $ listToJSON a -- copy of PersistList's definition
PersistObjectId _ -> P.error "Refusing to serialize a PersistObjectId to a SQLite value"
)
$ zip [1..] sqlData
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-sqlite-2.9.2/persistent-sqlite.cabal new/persistent-sqlite-2.10.0/persistent-sqlite.cabal
--- old/persistent-sqlite-2.9.2/persistent-sqlite.cabal 2018-12-30 05:47:05.000000000 +0100
+++ new/persistent-sqlite-2.10.0/persistent-sqlite.cabal 2019-04-19 02:00:35.000000000 +0200
@@ -1,5 +1,5 @@
name: persistent-sqlite
-version: 2.9.2
+version: 2.10.0
license: MIT
license-file: LICENSE
author: Michael Snoyman