hasql 1.10.3.1 → 1.10.3.2
raw patch · 7 files changed
+110/−43 lines, 7 filesdep +comonad
Dependencies added: comonad
Files
- hasql.cabal +5/−2
- src/library-tests/Sharing/ByFeature/PreparedStatementCacheSpec.hs +41/−0
- src/library/Hasql/Comms/Recv.hs +13/−0
- src/library/Hasql/Comms/Roundtrip.hs +12/−1
- src/library/Hasql/Engine/Contexts/Pipeline.hs +38/−29
- src/library/Hasql/Engine/Structures/StatementCache.hs +0/−11
- src/library/Hasql/Platform/Prelude.hs +1/−0
hasql.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 1.10.3.1+version: 1.10.3.2 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -12,7 +12,7 @@ The API comes free from all kinds of exceptions. All error-reporting is explicit and is presented using the 'Either' type. - \"hasql\" requires you to have the "\libpq\" C-library of at least version 14 installed to compile.+ \"hasql\" requires you to have the \"libpq\" C-library of at least version 14 installed to compile. \"libpq\" comes distributed with PostgreSQL, so typically all you need is just to install the latest PostgreSQL distro. @@ -157,6 +157,7 @@ base >=4.14 && <5, bytestring >=0.10 && <0.13, bytestring-strict-builder >=0.4.5.4 && <0.5,+ comonad ^>=5, contravariant >=1.3 && <2, dlist >=0.8 && <0.9 || >=1 && <2, hashable >=1.2 && <2,@@ -232,6 +233,7 @@ attoparsec >=0.10 && <0.15, base >=4.14 && <5, bytestring >=0.10 && <0.13,+ comonad ^>=5, contravariant >=1.3 && <2, dlist >=0.8 && <0.9 || >=1 && <2, hashable >=1.2 && <2,@@ -275,6 +277,7 @@ build-depends: base >=4.14 && <5, bytestring >=0.10 && <0.13,+ comonad ^>=5, contravariant >=1.3 && <2, dlist >=0.8 && <0.9 || >=1 && <2, hashable >=1.2 && <2,
src/library-tests/Sharing/ByFeature/PreparedStatementCacheSpec.hs view
@@ -124,6 +124,47 @@ Right _ -> expectationFailure "Second run unexpectedly succeeded" + it "A pipeline with a broken statement first and a valid one after it can be retried with the same syntax error" \config -> do+ Scripts.onPreparableConnection config \connection -> do+ let broken = Statement.preparable "S" mempty Decoders.noResult+ ok = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+ result1 <- Connection.use connection do+ Session.pipeline do+ (,)+ <$> Pipeline.statement () broken+ <*> Pipeline.statement () ok+ error1 <- case result1 of+ Left error1 -> pure error1+ Right _ -> fail "First run unexpectedly succeeded"++ result2 <- Connection.use connection do+ Session.pipeline do+ (,)+ <$> Pipeline.statement () broken+ <*> Pipeline.statement () ok+ error2 <- case result2 of+ Left error2 -> pure error2+ Right _ -> fail "Second run unexpectedly succeeded"+ shouldBe error2 error1++ it "A valid statement after a broken pipeline statement still prepares in a later pipeline" \config -> do+ Scripts.onPreparableConnection config \connection -> do+ let broken = Statement.preparable "S" mempty Decoders.noResult+ trailing = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+ result1 <- Connection.use connection do+ Session.pipeline do+ (,)+ <$> Pipeline.statement () broken+ <*> Pipeline.statement () trailing+ shouldBe (isLeft result1) True++ result2 <- Connection.use connection do+ Session.pipeline do+ Pipeline.statement () trailing+ case result2 of+ Right val -> val `shouldBe` 1+ Left err -> expectationFailure ("Unexpected error on follow-up pipeline: " <> show err)+ it "A pipeline with successful statements followed by a broken one can be retried without 'already exists' errors" \config -> do Scripts.onPreparableConnection config \connection -> do let ok1 = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))
src/library/Hasql/Comms/Recv.hs view
@@ -93,3 +93,16 @@ -- | Expected count. Int deriving stock (Show, Eq, Functor)++instance Comonad Error where+ {-# INLINE extract #-}+ extract = \case+ ResultError context _ _ -> context+ NoResultsError context _ -> context+ TooManyResultsError context _ -> context++ {-# INLINE duplicate #-}+ duplicate e = case e of+ ResultError _ resultIndex resultError -> ResultError e resultIndex resultError+ NoResultsError _ details -> NoResultsError e details+ TooManyResultsError _ expectedCount -> TooManyResultsError e expectedCount
src/library/Hasql/Comms/Roundtrip.hs view
@@ -126,4 +126,15 @@ data Error context = ClientError context (Maybe ByteString) | ServerError (Recv.Error context)- deriving stock (Show, Eq)+ deriving stock (Show, Eq, Functor)++instance Comonad Error where+ {-# INLINE extract #-}+ extract = \case+ ClientError context _ -> context+ ServerError recvError -> extract recvError++ {-# INLINE duplicate #-}+ duplicate = \case+ clientError@(ClientError _ details) -> ClientError clientError details+ ServerError recvError -> ServerError (fmap ServerError (duplicate recvError))
src/library/Hasql/Engine/Contexts/Pipeline.hs view
@@ -9,6 +9,7 @@ import Data.HashSet qualified as HashSet import Hasql.Codecs.Encoders.Params qualified as Params import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Comms.Recv qualified as Comms.Recv import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip import Hasql.Engine.Decoders.Result qualified as Decoders.Result import Hasql.Engine.Errors qualified as Errors@@ -29,7 +30,7 @@ OidCache.OidCache, StatementCache.StatementCache )-run (Pipeline totalStatements unknownTypes run) usePreparedStatements connection oidCache statementCache = do+run (Pipeline totalStatements unknownTypes runPipeline) usePreparedStatements connection oidCache statementCache = do let missingTypes = OidCache.selectUnknownNames unknownTypes oidCache oidCacheUpdates <- PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes) case oidCacheUpdates of@@ -42,29 +43,29 @@ then pure (Left (Errors.MissingTypesSessionError notFoundTypes), oidCache, statementCache) else do let newOidCache = oidCache <> OidCache.fromHashMap oidCacheUpdates-- let (roundtrip, newStatementCache) = run 0 usePreparedStatements (OidCache.toHashMap newOidCache) statementCache+ (roundtrip, newStatementCache) =+ runPipeline 0 usePreparedStatements (OidCache.toHashMap newOidCache) statementCache+ contextualRoundtrip = first Just roundtrip - result <-- let adaptedRoundtrip = first adaptContext roundtrip- where- adaptContext :: Context -> Maybe (Int, Int, ByteString, [Text], Bool)- adaptContext (Context index sql params prepared) =- Just (totalStatements, index, sql, params, prepared)- in Comms.Roundtrip.toPipelineIO adaptedRoundtrip Nothing connection- & fmap- ( first- ( \case- Comms.Roundtrip.ClientError _context details ->- Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)- Comms.Roundtrip.ServerError recvError ->- Errors.fromRecvError recvError- )- )+ executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection - let finalStatementCache = case result of- Left _ -> StatementCache.revertTo statementCache newStatementCache- Right _ -> newStatementCache+ let result =+ first+ ( \case+ Comms.Roundtrip.ClientError _context details ->+ Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+ Comms.Roundtrip.ServerError recvError ->+ Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)+ )+ executionResult+ finalStatementCache =+ case executionResult of+ Right _ -> newStatementCache+ Left executionError ->+ maybe+ statementCache+ (\(Context _ _ _ _ statementCache) -> statementCache)+ (extract executionError) pure (result, newOidCache, finalStatementCache) @@ -80,7 +81,7 @@ -- An obvious question rises then: why not execute all queries like that? -- In situations where the parameters depend on the result of another query it is impossible to execute them in parallel, because the client needs to receive the results of one query before sending the request to execute the next. -- This reasoning is essentially the same as the one for the difference between 'Applicative' and 'Monad'.--- That\'s why 'Pipeline' does not have the 'Monad' instance.+-- That's why 'Pipeline' does not have the 'Monad' instance. -- -- To execute 'Pipeline' lift it into 'Hasql.Session.Session' via 'Hasql.Session.pipeline'. --@@ -103,7 +104,7 @@ -- insertOrders :: [OrderDetails] -> 'Hasql.Session.Session' [OrderId] -- insertOrders orders = -- 'Hasql.Session.pipeline' $--- for orders $ \\order ->+-- for orders $ \order -> -- 'Hasql.Pipeline.statement' order Statements.insertOrder -- @ --@@ -149,7 +150,10 @@ -- -- The function takes the current statement cache and returns a tuple of: -- 1. The actual roundtrip action to be executed in the pipeline.- -- 2. The updated statement cache after executing this part of the pipeline.+ -- 2. The updated statement cache after composing this part of the pipeline.+ --+ -- The resulting cache is optimistic: on failure we recover the last known+ -- committed cache from statement contexts carried by roundtrip errors. ( Int -> Bool -> HashMap (Maybe Text, Text) (Word32, Word32) ->@@ -167,6 +171,8 @@ [Text] -- | Whether the statement is prepared. Bool+ -- | The so far successfully updated statement cache.+ StatementCache.StatementCache deriving stock (Show, Eq) -- * Instances@@ -219,12 +225,13 @@ prepare = usePreparedStatements && preparable - context =+ context soFarStatementCache = Context offset sql (Params.renderReadable encoder params) prepare+ soFarStatementCache runPrepared statementCache = (roundtrip, newStatementCache)@@ -237,8 +244,10 @@ in (True, remoteKey, newStatementCache) roundtrip =- when isNew (Comms.Roundtrip.prepare context remoteKey sql pqOidList)- *> Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder'+ when+ isNew+ (Comms.Roundtrip.prepare (context statementCache) remoteKey sql pqOidList)+ *> Comms.Roundtrip.queryPrepared (context newStatementCache) remoteKey encodedParams Pq.Binary decoder' where encodedParams = valueAndFormatList@@ -248,7 +257,7 @@ (roundtrip, statementCache) where roundtrip =- Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder'+ Comms.Roundtrip.queryParams (context statementCache) sql encodedParams Pq.Binary decoder' where encodedParams = params
src/library/Hasql/Engine/Structures/StatementCache.hs view
@@ -5,7 +5,6 @@ lookup, insert, reset,- revertTo, ) where @@ -44,16 +43,6 @@ {-# INLINEABLE reset #-} reset :: StatementCache -> StatementCache reset _ = StatementCache HashMap.empty 0---- | Revert the entries to those of the provided cache, preserving the counter of the receiver.------ This is useful when a pipeline fails and we want to discard tentative entries--- (which might not have been successfully prepared on the server)--- while keeping the counter advanced to avoid name collisions with orphaned server-side statements.-{-# INLINEABLE revertTo #-}-revertTo :: StatementCache -> StatementCache -> StatementCache-revertTo (StatementCache oldHashMap _) (StatementCache _ newCounter) =- StatementCache oldHashMap newCounter -- | -- Local statement key.
src/library/Hasql/Platform/Prelude.hs view
@@ -10,6 +10,7 @@ import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports+import Control.Comonad as Exports (Comonad (..)) import Control.Concurrent as Exports import Control.Exception as Exports hiding (Handler) import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)