postgresql-simple 0.6.5.1 → 0.7.0.1
raw patch · 16 files changed
Files
- CHANGES.md +10/−0
- postgresql-simple.cabal +25/−48
- src/Database/PostgreSQL/Simple.hs +1/−0
- src/Database/PostgreSQL/Simple/Compat.hs +0/−53
- src/Database/PostgreSQL/Simple/Copy.hs +1/−4
- src/Database/PostgreSQL/Simple/Errors.hs +3/−2
- src/Database/PostgreSQL/Simple/FromField.hs +4/−6
- src/Database/PostgreSQL/Simple/HStore/Implementation.hs +0/−6
- src/Database/PostgreSQL/Simple/Internal.hs +33/−7
- src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs +1/−4
- src/Database/PostgreSQL/Simple/Notification.hs +0/−17
- src/Database/PostgreSQL/Simple/Ok.hs +0/−4
- src/Database/PostgreSQL/Simple/ToField.hs +0/−4
- src/Database/PostgreSQL/Simple/Types.hs +0/−7
- test/Exception.hs +70/−0
- test/Main.hs +2/−0
CHANGES.md view
@@ -1,3 +1,13 @@+### Version 0.7.0.0 (2023-07-31)++ * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).+ * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,+ by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.+ * Drop support for GHC prior 8.6+ * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.+ This allows to catch all `postgresql-simple` exceptions at once.+ (c.f. `AsyncException` in `base).+ ### Version 0.6.5.1 (2023-07-09) * Support `aeson-2.2.0.0`
postgresql-simple.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: postgresql-simple-version: 0.6.5.1+version: 0.7.0.1 synopsis: Mid-Level PostgreSQL client library description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -23,19 +23,16 @@ test/results/unique-constraint-violation.expected tested-with:- GHC ==7.6.3- || ==7.8.4- || ==7.10.3- || ==8.0.2- || ==8.2.2- || ==8.4.4- || ==8.6.5+ GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8- || ==9.4.5- || ==9.6.2+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.2+ || ==9.12.2 library default-language: Haskell2010@@ -81,34 +78,25 @@ -- GHC bundled libs build-depends:- base >=4.6.0.0 && <4.19- , bytestring >=0.10.0.0 && <0.12- , containers >=0.5.0.0 && <0.7- , template-haskell >=2.8.0.0 && <2.21- , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1+ base >=4.12.0.0 && <4.22+ , bytestring >=0.10.8.2 && <0.13+ , containers >=0.6.0.1 && <0.8+ , template-haskell >=2.14.0.0 && <2.24+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 , time-compat >=1.9.5 && <1.12- , transformers >=0.3.0.0 && <0.7+ , transformers >=0.5.6.2 && <0.7 -- Other dependencies build-depends:- aeson >=1.4.1.0 && <1.6 || >=2.0.0.0 && <2.3- , attoparsec >=0.13.2.2 && <0.15- , bytestring-builder >=0.10.8.1.0 && <0.11- , case-insensitive >=1.2.0.11 && <1.3- , hashable >=1.2.7.0 && <1.5- , Only >=0.1 && <0.1.1- , postgresql-libpq >=0.9.4.3 && <0.10- , scientific >=0.3.6.2 && <0.4- , uuid-types >=1.0.3 && <1.1- , vector >=0.12.0.1 && <0.14-- if !impl(ghc >=8.0)- build-depends:- fail >=4.9.0.0 && <4.10- , semigroups >=0.18.5 && <0.21-- if !impl(ghc >=7.6)- build-depends: ghc-prim+ aeson >=2.1.2.1 && <2.3+ , attoparsec >=0.14.4 && <0.15+ , case-insensitive >=1.2.1.0 && <1.3+ , hashable >=1.4.3.0 && <1.6+ , Only >=0.1 && <0.1.1+ , postgresql-libpq >=0.10.0.0 && <0.12+ , scientific >=0.3.7.0 && <0.4+ , uuid-types >=1.0.5 && <1.1+ , vector >=0.13.0.0 && <0.14 default-extensions: BangPatterns@@ -123,22 +111,14 @@ type: git location: http://github.com/haskellari/postgresql-simple -source-repository this- type: git- location: http://github.com/haskellari/postgresql-simple- tag: v0.6.3- test-suite inspection- if !impl(ghc >=8.0)- buildable: False- default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Inspection.hs build-depends: base- , inspection-testing >=0.4.1.1 && <0.6+ , inspection-testing >=0.4.1.1 && <0.7 , postgresql-libpq , postgresql-simple , tasty@@ -151,10 +131,11 @@ main-is: Main.hs other-modules: Common+ Exception+ Interval Notify Serializable Time- Interval ghc-options: -threaded ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind@@ -175,7 +156,6 @@ , containers , cryptohash-md5 >=0.11.100.1 && <0.12 , filepath- , HUnit , postgresql-simple , tasty , tasty-golden@@ -183,9 +163,6 @@ , text , time-compat , vector-- if !impl(ghc >=7.6)- build-depends: ghc-prim benchmark select default-language: Haskell2010
src/Database/PostgreSQL/Simple.hs view
@@ -64,6 +64,7 @@ , Only(..) , (:.)(..) -- ** Exceptions+ , SomePostgreSqlException(..) , SqlError(..) , PQ.ExecStatus(..) , FormatError(..)
src/Database/PostgreSQL/Simple/Compat.hs view
@@ -12,36 +12,13 @@ ) where import qualified Control.Exception as E-import Data.Monoid import Data.ByteString (ByteString)-#if MIN_VERSION_bytestring(0,10,0) import Data.ByteString.Lazy (toStrict)-#else-import qualified Data.ByteString as B-import Data.ByteString.Lazy (toChunks)-#endif import Data.ByteString.Builder (Builder, toLazyByteString)--#if MIN_VERSION_scientific(0,3,0) import Data.Text.Lazy.Builder.Scientific (scientificBuilder)-#else-import Data.Scientific (scientificBuilder)-#endif--#if __GLASGOW_HASKELL__ >= 702 import System.IO.Unsafe (unsafeDupablePerformIO)-#elif __GLASGOW_HASKELL__ >= 611-import GHC.IO (unsafeDupablePerformIO)-#else-import GHC.IOBase (unsafeDupablePerformIO)-#endif- import Data.Fixed (Pico)-#if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(MkFixed))-#else-import Unsafe.Coerce (unsafeCoerce)-#endif -- | Like 'E.mask', but backported to base before version 4.3.0. --@@ -51,44 +28,14 @@ -- 'withTransactionMode' function calls the restore callback only once, so we -- don't need that polymorphism. mask :: ((IO a -> IO a) -> IO b) -> IO b-#if MIN_VERSION_base(4,3,0) mask io = E.mask $ \restore -> io restore-#else-mask io = do- b <- E.blocked- E.block $ io $ \m -> if b then m else E.unblock m-#endif {-# INLINE mask #-} -#if !MIN_VERSION_base(4,5,0)-infixr 6 <>--(<>) :: Monoid m => m -> m -> m-(<>) = mappend-{-# INLINE (<>) #-}-#endif- toByteString :: Builder -> ByteString-#if MIN_VERSION_bytestring(0,10,0) toByteString x = toStrict (toLazyByteString x)-#else-toByteString x = B.concat (toChunks (toLazyByteString x))-#endif -#if MIN_VERSION_base(4,7,0)- toPico :: Integer -> Pico toPico = MkFixed fromPico :: Pico -> Integer fromPico (MkFixed i) = i--#else--toPico :: Integer -> Pico-toPico = unsafeCoerce--fromPico :: Pico -> Integer-fromPico = unsafeCoerce--#endif
src/Database/PostgreSQL/Simple/Copy.hs view
@@ -86,15 +86,12 @@ PQ.TuplesOk -> err PQ.CopyOut -> return () PQ.CopyIn -> return ()-#if MIN_VERSION_postgresql_libpq(0,9,3) PQ.CopyBoth -> errMsg "COPY BOTH is not supported"-#endif-#if MIN_VERSION_postgresql_libpq(0,9,2) PQ.SingleTuple -> errMsg "single-row mode is not supported"-#endif PQ.BadResponse -> throwResultError funcName result status PQ.NonfatalError -> throwResultError funcName result status PQ.FatalError -> throwResultError funcName result status+ _ -> throwResultError funcName result status -- TODO data CopyOutResult = CopyOutRow !B.ByteString -- ^ Data representing either exactly
src/Database/PostgreSQL/Simple/Errors.hs view
@@ -25,7 +25,6 @@ ) where -import Control.Applicative import Control.Exception as E import Data.Attoparsec.ByteString.Char8@@ -60,7 +59,9 @@ deriving (Show, Eq, Ord, Typeable) -- Default instance should be enough-instance Exception ConstraintViolation+instance Exception ConstraintViolation where+ toException = postgresqlExceptionToException+ fromException = postgresqlExceptionFromException -- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
src/Database/PostgreSQL/Simple/FromField.hs view
@@ -118,7 +118,7 @@ import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) ) import Control.Concurrent.MVar (MVar, newMVar)-import Control.Exception (Exception)+import Control.Exception (Exception (toException, fromException)) import qualified Data.Aeson as JSON import Data.Attoparsec.ByteString.Char8 hiding (Result) import Data.ByteString (ByteString)@@ -154,11 +154,7 @@ import Data.Scientific (Scientific) import GHC.Real (infinity, notANumber) -#if MIN_VERSION_aeson(2,1,2) import qualified Data.Aeson.Types as JSON-#else-import qualified Data.Aeson.Internal as JSON-#endif -- | Exception thrown if conversion from a SQL value to a Haskell -- value fails.@@ -186,7 +182,9 @@ -- between metadata and actual data in a row). deriving (Eq, Show, Typeable) -instance Exception ResultError+instance Exception ResultError where+ toException = postgresqlExceptionToException+ fromException = postgresqlExceptionFromException left :: Exception a => a -> Conversion b left = conversionError
src/Database/PostgreSQL/Simple/HStore/Implementation.hs view
@@ -22,9 +22,6 @@ import qualified Data.ByteString.Builder as BU import Data.ByteString.Internal (c2w, w2c) import qualified Data.ByteString.Lazy as BL-#if !MIN_VERSION_bytestring(0,10,0)-import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)-#endif import Data.Map(Map) import qualified Data.Map as Map import Data.Text(Text)@@ -69,9 +66,6 @@ instance Monoid HStoreBuilder where mempty = Empty-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)-#endif class ToHStoreText a where toHStoreText :: a -> HStoreText
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE InstanceSigs #-} ------------------------------------------------------------------------------ -- |@@ -34,7 +36,6 @@ import qualified Data.IntMap as IntMap import Data.IORef import Data.Maybe(fromMaybe)-import Data.Monoid import Data.String import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -82,6 +83,25 @@ instance Eq Connection where x == y = connectionHandle x == connectionHandle y +-- | Superclass for postgresql exceptions+data SomePostgreSqlException = forall e. Exception e => SomePostgreSqlException e+ deriving Typeable++postgresqlExceptionToException :: Exception e => e -> SomeException+postgresqlExceptionToException = toException . SomePostgreSqlException++postgresqlExceptionFromException :: Exception e => SomeException -> Maybe e+postgresqlExceptionFromException x = do+ SomePostgreSqlException a <- fromException x+ cast a++instance Show SomePostgreSqlException where+ showsPrec :: Int -> SomePostgreSqlException -> ShowS+ showsPrec p (SomePostgreSqlException e) = showsPrec p e++instance Exception SomePostgreSqlException where+ displayException (SomePostgreSqlException e) = displayException e+ data SqlError = SqlError { sqlState :: ByteString , sqlExecStatus :: ExecStatus@@ -93,8 +113,11 @@ fatalError :: ByteString -> SqlError fatalError msg = SqlError "" FatalError msg "" "" -instance Exception SqlError+instance Exception SqlError where+ toException = postgresqlExceptionToException+ fromException = postgresqlExceptionFromException + -- | Exception thrown if 'query' is used to perform an @INSERT@-like -- operation, or 'execute' is used to perform a @SELECT@-like operation. data QueryError = QueryError {@@ -102,7 +125,9 @@ , qeQuery :: Query } deriving (Eq, Show, Typeable) -instance Exception QueryError+instance Exception QueryError where+ toException = postgresqlExceptionToException+ fromException = postgresqlExceptionFromException -- | Exception thrown if a 'Query' could not be formatted correctly. -- This may occur if the number of \'@?@\' characters in the query@@ -113,7 +138,9 @@ , fmtParams :: [ByteString] } deriving (Eq, Show, Typeable) -instance Exception FormatError+instance Exception FormatError where+ toException = postgresqlExceptionToException+ fromException = postgresqlExceptionFromException data ConnectInfo = ConnectInfo { connectHost :: String@@ -369,6 +396,7 @@ PQ.BadResponse -> getResult h mres' PQ.NonfatalError -> getResult h mres' PQ.FatalError -> getResult h mres'+ _ -> error "incomplete match" #endif -- | A version of 'execute' that does not perform query substitution.@@ -404,6 +432,7 @@ PQ.BadResponse -> throwResultError "execute" result status PQ.NonfatalError -> throwResultError "execute" result status PQ.FatalError -> throwResultError "execute" result status+ _ -> throwResultError "execute: TODO" result status where mkInteger str = B8.foldl' delta 0 str where@@ -490,9 +519,6 @@ Errors _ -> (oka <|>) <$> runConversion mb conn instance Monad Conversion where-#if !(MIN_VERSION_base(4,8,0))- return = pure-#endif m >>= f = Conversion $ \conn -> do oka <- runConversion m conn case oka of
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs view
@@ -76,15 +76,12 @@ PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)" PQ.CopyOut -> queryErr "query: COPY TO is not supported" PQ.CopyIn -> queryErr "query: COPY FROM is not supported"-#if MIN_VERSION_postgresql_libpq(0,9,3) PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"-#endif-#if MIN_VERSION_postgresql_libpq(0,9,2) PQ.SingleTuple -> queryErr "query: single-row mode is not supported"-#endif PQ.BadResponse -> throwResultError "query" result status PQ.NonfatalError -> throwResultError "query" result status PQ.FatalError -> throwResultError "query" result status+ _ -> throwResultError "query: TODO" result status where queryErr msg = throwIO $ QueryError msg q
src/Database/PostgreSQL/Simple/Notification.hs view
@@ -47,8 +47,6 @@ #if defined(mingw32_HOST_OS) import Control.Concurrent ( threadDelay )-#elif !MIN_VERSION_base(4,7,0)-import Control.Concurrent ( threadWaitRead ) #else import GHC.Conc ( atomically ) import Control.Concurrent ( threadWaitReadSTM )@@ -94,21 +92,6 @@ -- with async exceptions, whereas threadDelay can. Just _fd -> do return (threadDelay 1000000 >> loop)-#elif !MIN_VERSION_base(4,7,0)- -- Technically there's a race condition that is usually benign.- -- If the connection is closed or reset after we drop the- -- lock, and then the fd index is reallocated to a new- -- descriptor before we call threadWaitRead, then- -- we could end up waiting on the wrong descriptor.- --- -- Now, if the descriptor becomes readable promptly, then- -- it's no big deal as we'll wake up and notice the change- -- on the next iteration of the loop. But if are very- -- unlucky, then we could end up waiting a long time.- Just fd -> do- return $ do- threadWaitRead fd `catch` (throwIO . setIOErrorLocation)- loop #else -- This case fixes the race condition above. By registering -- our interest in the descriptor before we drop the lock,
src/Database/PostgreSQL/Simple/Ok.hs view
@@ -72,10 +72,6 @@ mplus = (<|>) instance Monad Ok where-#if !(MIN_VERSION_base(4,8,0))- return = pure-#endif- Errors es >>= _ = Errors es Ok a >>= f = f a
src/Database/PostgreSQL/Simple/ToField.hs view
@@ -59,11 +59,7 @@ import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.Simple.Time import Data.Scientific (Scientific)-#if MIN_VERSION_scientific(0,3,0) import Data.Text.Lazy.Builder.Scientific (scientificBuilder)-#else-import Data.Scientific (scientificBuilder)-#endif import Foreign.C.Types (CUInt(..)) -- | How to render an element when substituting it into a query.
src/Database/PostgreSQL/Simple/Types.hs view
@@ -50,10 +50,6 @@ data Null = Null deriving (Read, Show, Typeable) -instance Eq Null where- _ == _ = False- _ /= _ = False- -- | A placeholder for the PostgreSQL @DEFAULT@ value. data Default = Default deriving (Read, Show, Typeable)@@ -97,9 +93,6 @@ instance Monoid Query where mempty = Query B.empty-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)-#endif -- | Wrap a list of values for use in an @IN@ clause. Replaces a -- single \"@?@\" character with a parenthesized list of rendered
+ test/Exception.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Exception (testExceptions) where++import Database.PostgreSQL.Simple+import Test.Tasty.HUnit (Assertion, assertBool)+import Common (TestEnv)+import Control.Exception (Exception (..), SomeException)+import Data.Maybe (isJust)+import Data.Either (isLeft)+import Control.Exception (throwIO, try)++testExceptions :: TestEnv -> Assertion+testExceptions _ = do+ let sqlError = SqlError+ { sqlState = ""+ , sqlExecStatus = FatalError+ , sqlErrorMsg = ""+ , sqlErrorDetail = ""+ , sqlErrorHint = ""+ }+ let sqlEx :: SomeException = toException sqlError+ assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)+ assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)+ eSqlError :: Either SqlError () <- try $ throwIO sqlEx+ assertBool "Can catch SqlError" $ isLeft eSqlError+ eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx+ assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx++ let formatError = FormatError+ { fmtMessage = ""+ , fmtQuery = ""+ , fmtParams = []+ }+ let formatEx :: SomeException = toException formatError+ assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)+ assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)+ eFormatError :: Either FormatError () <- try $ throwIO formatEx+ assertBool "Can catch FormatError" $ isLeft eFormatError+ eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx+ assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx++ let queryError = QueryError+ { qeMessage = ""+ , qeQuery = ""+ }+ let queryEx :: SomeException = toException queryError+ assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)+ assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)+ eQueryError :: Either QueryError () <- try $ throwIO queryEx+ assertBool "Can catch QueryError" $ isLeft eQueryError+ eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx+ assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx++ let resultError = Incompatible+ { errSQLType = ""+ , errSQLTableOid = Nothing+ , errSQLField = ""+ , errHaskellType = ""+ , errMessage = ""+ }+ let resultEx :: SomeException = toException resultError+ assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)+ assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)+ eResultEx :: Either ResultError () <- try $ throwIO resultEx+ assertBool "Can catch ResultError" $ isLeft eResultEx+ eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx+ assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx
test/Main.hs view
@@ -55,6 +55,7 @@ import Serializable import Time import Interval+import Exception (testExceptions) tests :: TestEnv -> TestTree tests env = testGroup "tests"@@ -84,6 +85,7 @@ , testCase "2-ary generic" . testGeneric2 , testCase "3-ary generic" . testGeneric3 , testCase "Timeout" . testTimeout+ , testCase "Exceptions" . testExceptions ] testBytea :: TestEnv -> TestTree