postgresql-pure 0.1.0.0 → 0.1.1.0

raw patch · 6 files changed

+44/−38 lines, 6 files

Files

• ChangeLog.md +9/−3
• postgresql-pure.cabal +2/−2
• src/Database/PostgreSQL/Pure/Internal/Exception.hs +2/−2
• src/Database/PostgreSQL/Pure/Internal/Query.hs +22/−20
• src/Database/PostgreSQL/Pure/Internal/SocketIO.hs +8/−10
• test-relational-record/DataSource.hs +1/−1

@@ -1,10 +1,16 @@-# Changelog for postgres-pure+# Changelog for postgresql-pure -## 0.1.0+## 0.1.1.0  2019.10.21 -Release.+- Fix an issue sometimes missing “Error” responses after “Sync” requests.++## 0.1.0.0++2019.10.21++- Release.  ### Known Issues 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: bbd1588f7e1a8f7ac0f863daa68188df3e5ac652f2214749c877d9d10d1610d4+-- hash: 66e926e8e00816948836fb12c40af085773cf4e85b46359544cfacb18c35295c  name:           postgresql-pure-version:        0.1.0.0+version:        0.1.1.0 synopsis:       pure Haskell PostgreSQL driver description:    pure Haskell PostgreSQL driver category:       Database

@@ -71,7 +71,7 @@  data InternalException   = InternalResponseParsingFailed String BS.ByteString-  | InternalErrorResponse ErrorFields (Maybe TransactionState)+  | InternalErrorResponse ErrorFields (Maybe TransactionState) BS.ByteString   | InternalExtraData BS.ByteString   deriving (Show, Read, Eq, Typeable) @@ -79,7 +79,7 @@  internalExcepionToExposedException :: InternalException -> Exception internalExcepionToExposedException e@InternalResponseParsingFailed {} = Exception $ ResponseParsingFailed $ displayException e-internalExcepionToExposedException (InternalErrorResponse (ErrorFields fields) transactionState) =+internalExcepionToExposedException (InternalErrorResponse (ErrorFields fields) transactionState _) =   Exception ErrorResponse { severity, code, message, transactionState }   where     (severity, code, message) = map3 BSS.fromShort $ foldr go ("", "", "") fields

@@ -58,6 +58,7 @@ import           Control.Exception.Safe                      (throw, try) import           Control.Monad                               (void, when) import           Control.Monad.Fail                          (MonadFail)+import           Control.Monad.State.Strict                  (put) import qualified Data.Attoparsec.ByteString                  as AP import qualified Data.Attoparsec.Combinator                  as AP import qualified Data.ByteString.Builder                     as BSB@@ -246,37 +247,38 @@ -- | To build and send the given message and a “Flush” message and to receive and parse those responses. flush :: Message m => Connection -> m -> IO (MessageResult m) flush Connection { socket, sendingBuffer, receptionBuffer, config } m =-  Exception.convert $ do-    r <- try $-      runSocketIO socket sendingBuffer receptionBuffer config $ do+  Exception.convert $+    runSocketIO socket sendingBuffer receptionBuffer config $ do+      r <- try $ do         buildAndSend $ builder m <> BSB.byteString Builder.flush         receive $ parser m-    case r of-      Right r -> pure r-      Left (Exception.InternalErrorResponse fields _) -> do-        ReadyForQuery ts <--          runSocketIO socket sendingBuffer receptionBuffer config $ do+      case r of+        Right r -> pure r+        Left (Exception.InternalErrorResponse fields _ _) -> do+          ReadyForQuery ts <- do+            put mempty             send Builder.sync             receive Parser.readyForQuery-        throw $ Exception.InternalErrorResponse fields $ Just ts-      Left e -> throw e+          throw $ Exception.InternalErrorResponse fields (Just ts) mempty+        Left e -> throw e  -- | To build and send the given message and a “Sync” message and to receive and parse those responses. sync :: Message m => Connection -> m -> IO (MessageResult m, TransactionState) sync Connection { socket, sendingBuffer, receptionBuffer, config } m =-  Exception.convert $ do-    r <--      try $-        runSocketIO socket sendingBuffer receptionBuffer config $ do+  Exception.convert $+    runSocketIO socket sendingBuffer receptionBuffer config $ do+      r <-+        try $ do           buildAndSend $ builder m <> BSB.byteString Builder.sync           (r, ReadyForQuery ts) <- receive $ (,) <$> parser m <*> Parser.readyForQuery           pure (r, ts)-    case r of-      Right r -> pure r-      Left (Exception.InternalErrorResponse fields _) -> do-        ReadyForQuery ts <- runSocketIO socket sendingBuffer receptionBuffer config $ receive Parser.readyForQuery-        throw $ Exception.InternalErrorResponse fields $ Just ts-      Left e -> throw e+      case r of+        Right r -> pure r+        Left (Exception.InternalErrorResponse fields _ rest) -> do+          put rest+          ReadyForQuery ts <- receive Parser.readyForQuery+          throw $ Exception.InternalErrorResponse fields (Just ts) mempty+        Left e -> throw e  -- | To send @BEGIN@ SQL statement. begin :: ExecutedProcedure ()

@@ -79,8 +79,8 @@     result <- AP.parseWith recv parser carry     case result of       AP.Done rest response -> pure (response, rest)-      AP.Fail rest [] msg      -> throw $ Exception.InternalResponseParsingFailed msg rest-      AP.Fail rest ctxs msg    -> throw $ Exception.InternalResponseParsingFailed (intercalate " > " ctxs <> ": " <> msg) rest+      AP.Fail rest [] msg   -> throw $ Exception.InternalResponseParsingFailed msg rest+      AP.Fail rest ctxs msg -> throw $ Exception.InternalResponseParsingFailed (intercalate " > " ctxs <> ": " <> msg) rest       AP.Partial _          -> Exception.cantReachHere  receiveJust :: AP.Parser response -> SocketIO response@@ -95,14 +95,12 @@ receive parser = do   r <- try $ receiveJust parser   case r of-    Right r             -> pure r-    Left e@(Exception.InternalResponseParsingFailed _ raw) -> do-      let-        r = AP.parseOnly Parser.skipUntilError raw-      throw $-        case r of-          Right (Error fields) -> Exception.InternalErrorResponse fields Nothing-          Left _               -> e+    Right r -> pure r+    Left e@(Exception.InternalResponseParsingFailed _ raw) ->+      case AP.parse Parser.skipUntilError raw of+        AP.Done rest (Error fields) -> throw $ Exception.InternalErrorResponse fields Nothing rest+        AP.Fail _ _ _               -> throw e+        AP.Partial _                -> throw e     Left e -> throw e  -- Before network 3.0.0.0, recvBuf raises error on EOF. Otherwise it returns 0 on EOF.

@@ -4,4 +4,4 @@ import           Database.HDBC.PostgreSQL (Connection, connectPostgreSQL)  connect :: IO Connection-connect = connectPostgreSQL "user='postgres'"+connect = connectPostgreSQL "host='localhost' user='postgres'"