diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,18 +1,22 @@ For the full changelog, see -### Version 0.5.2.0 (2016-05-25) - * Significantly improved the error reporting from - `Copy.putCopyData`, thanks to Ben Gamari. +### Version 0.5.2.1 (2016-06-29) + * Bumped the lower bound for `base` to 4.6. Thanks to Herbert + Valerio Riedel for reporting the issue. - * Moved the test suite to use `tasty`, with a big thanks - to Ben Gamari. + * Added an `Eq` instance for `SqlError`, thanks to Chris Allen - * Added `FromField.optionalField`, and updated the documentation - of `FromField.fromJSONField`, as inspired by an email conversation - with Ian Wagner. + * Fixed a bug where a all-caps `"NULL"` text value inside a + postgresql array would get parsed as the SQL null value. Thanks + goes to Edgar Gomes and Silk for finding and fixing this mistake. - * Updated all links in the haddocks to use https, and added a link - to the documentation of `connectPostgreSQL`. + * Modified `withTransaction` and friends to ignore `IOError`s when + attempting to roll back the transaction. This fixes a buggy + interaction between `withTransaction` and async exceptions (e.g. + `System.Timeout`) on unix platforms. Thanks goes to Erik + Hesselink and Silk for providing the test case that exposed this + issue. - * Added a truncated changelog to the source distribution. + * Added the `testTimeout` regression test for the problem above. + diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -31,3 +31,5 @@ Timo von Holtz Amit Levy Ben Gamari +Edgar Gomes Araujo +Erik Hesselink diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -1,5 +1,5 @@ Name: postgresql-simple -Version: 0.5.2.0 +Version: 0.5.2.1 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple. @@ -57,7 +57,7 @@ Build-depends: aeson >= 0.6, attoparsec >= 0.10.3, - base >= 4.4 && < 5, + base >= 4.6 && < 5, bytestring >= 0.9, bytestring-builder, case-insensitive, @@ -88,7 +88,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple - tag: v0.5.2.0 + tag: v0.5.2.1 test-suite test type: exitcode-stdio-1.0 diff --git a/src/Database/PostgreSQL/Simple/FromField.hs b/src/Database/PostgreSQL/Simple/FromField.hs --- a/src/Database/PostgreSQL/Simple/FromField.hs +++ b/src/Database/PostgreSQL/Simple/FromField.hs @@ -526,7 +526,7 @@ fElem = f{ typeOid = typoid (typelem typeInfo) } parseIt item = - fieldParser f' $ if item' == "NULL" then Nothing else Just item' + fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item' where item' = fmt delim item f' | Arrays.Array _ <- item = f diff --git a/src/Database/PostgreSQL/Simple/Internal.hs b/src/Database/PostgreSQL/Simple/Internal.hs --- a/src/Database/PostgreSQL/Simple/Internal.hs +++ b/src/Database/PostgreSQL/Simple/Internal.hs @@ -86,7 +86,7 @@ , sqlErrorMsg :: ByteString , sqlErrorDetail :: ByteString , sqlErrorHint :: ByteString - } deriving (Show, Typeable) + } deriving (Eq, Show, Typeable) fatalError :: ByteString -> SqlError fatalError msg = SqlError "" FatalError msg "" "" diff --git a/src/Database/PostgreSQL/Simple/Transaction.hs b/src/Database/PostgreSQL/Simple/Transaction.hs --- a/src/Database/PostgreSQL/Simple/Transaction.hs +++ b/src/Database/PostgreSQL/Simple/Transaction.hs @@ -1,5 +1,15 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} +------------------------------------------------------------------------------ +-- | +-- Module: Database.PostgreSQL.Simple.Transaction +-- Copyright: (c) 2011-2013 Leon P Smith +-- (c) 2013 Joey Adams +-- License: BSD3 +-- Maintainer: Leon P Smith +-- +------------------------------------------------------------------------------ + module Database.PostgreSQL.Simple.Transaction ( -- * Transaction handling @@ -132,7 +142,7 @@ withTransactionMode mode conn act = mask $ \restore -> do beginMode mode conn - r <- restore act `E.onException` rollback conn + r <- restore act `E.onException` rollback_ conn commit conn return r @@ -157,7 +167,7 @@ r <- act' case r of Left e -> do - rollback conn + rollback_ conn case fmap shouldRetry (E.fromException e) of Just True -> retryLoop act' _ -> E.throwIO e @@ -167,6 +177,10 @@ -- | Rollback a transaction. rollback :: Connection -> IO () rollback conn = execute_ conn "ABORT" >> return () + +-- | Rollback a transaction, ignoring any @IOErrors@ +rollback_ :: Connection -> IO () +rollback_ conn = rollback conn `E.catch` \(_ :: IOError) -> return () -- | Commit a transaction. commit :: Connection -> IO () diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DoAndIfThenElse #-} @@ -28,6 +29,8 @@ import qualified Data.Text.Encoding as T import qualified Data.Vector as V import System.FilePath +import System.Timeout(timeout) +import Data.Time(getCurrentTime, diffUTCTime) import Test.Tasty import Test.Tasty.Golden @@ -39,23 +42,25 @@ tests env = testGroup "tests" $ map ($ env) [ testBytea - , testCase "ExecuteMany" . testExecuteMany - , testCase "Fold" . testFold - , testCase "Notify" . testNotify - , testCase "Serializable" . testSerializable - , testCase "Time" . testTime - , testCase "Array" . testArray - , testCase "HStore" . testHStore - , testCase "JSON" . testJSON - , testCase "Savepoint" . testSavepoint - , testCase "Unicode" . testUnicode - , testCase "Values" . testValues - , testCase "Copy" . testCopy + , testCase "ExecuteMany" . testExecuteMany + , testCase "Fold" . testFold + , testCase "Notify" . testNotify + , testCase "Serializable" . testSerializable + , testCase "Time" . testTime + , testCase "Array" . testArray + , testCase "Array of nullables" . testNullableArray + , testCase "HStore" . testHStore + , testCase "JSON" . testJSON + , testCase "Savepoint" . testSavepoint + , testCase "Unicode" . testUnicode + , testCase "Values" . testValues + , testCase "Copy" . testCopy , testCopyFailures - , testCase "Double" . testDouble - , testCase "1-ary generic" . testGeneric1 - , testCase "2-ary generic" . testGeneric2 - , testCase "3-ary generic" . testGeneric3 + , testCase "Double" . testDouble + , testCase "1-ary generic" . testGeneric1 + , testCase "2-ary generic" . testGeneric2 + , testCase "3-ary generic" . testGeneric3 + , testCase "Timeout" . testTimeout ] testBytea :: TestEnv -> TestTree @@ -177,6 +182,14 @@ queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool) queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int) +testNullableArray :: TestEnv -> Assertion +testNullableArray TestEnv{..} = do + xs <- query_ conn "SELECT '{sometext, \"NULL\"}'::_text" + xs @?= [Only (V.fromList ["sometext", "NULL" :: Text])] + xs <- query_ conn "SELECT '{sometext, NULL}'::_text" + xs @?= [Only (V.fromList [Just "sometext", Nothing :: Maybe Text])] + queryFailure conn "SELECT '{sometext, NULL}'::_text" (undefined :: V.Vector Text) + testHStore :: TestEnv -> Assertion testHStore TestEnv{..} = do execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore" @@ -366,6 +379,22 @@ copyRows = ["1,foo\n" ,"2,bar\n" ,"z,baz\n"] + +testTimeout :: TestEnv -> Assertion +testTimeout TestEnv{..} = + withConn $ \c -> do + start_t <- getCurrentTime + res <- timeout 200000 $ do + withTransaction c $ do + query_ c "SELECT pg_sleep(1)" :: IO [Only ()] + end_t <- getCurrentTime + assertBool "Timeout did not occur" (res == Nothing) +#if !defined(mingw32_HOST_OS) +-- At the moment, you cannot timely abandon queries with async exceptions on +-- Windows. + let d = end_t `diffUTCTime` start_t + assertBool "Timeout didn't work in a timely fashion" (0.1 < d && d < 0.6) +#endif testDouble :: TestEnv -> Assertion testDouble TestEnv{..} = do