b91ff6d · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #123 from morphismtech/dev-error

error stuff

commitb91ff6d090ae8f94749389e296fa576fed476238 authorEitan Chatav <eitan.chatav@gmail.com> dateSat 13 Apr 2019, 23:41 (8 years ago) parent0158cb0 8d08fc1

4 files changed+31−30

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−10 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+24−17 squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+6−2 squeal-postgresql/test/Specs/ExceptionHandling.hs+1−1

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−10

@@ -156,7 +156,6 @@ import Data.Function ((&))

156156import Data.List ((\\))

157157import Data.Text (Text)

158158import Data.Time (UTCTime)

159−import Generics.SOP (K (..))

160159import Prelude hiding ((.), id)

161160import System.Environment

162161import UnliftIO (MonadIO (..))

@@ -314,15 +313,6 @@ instance Migratory (Terminally PQ IO) where

314313 okResult result

315314 ntuples result

316315

317−okResult :: K Result results -> PQ schema schema IO ()

318−okResult result = do

319− status <- resultStatus result

320− when (not (status `elem` [CommandOk, TuplesOk])) $ do

321− errorMessageMaybe <- resultErrorMessage result

322− case errorMessageMaybe of

323− Nothing -> error "migration: unknown error"

324− Just msg -> error ("migration: " <> show msg)

325−

326316unsafePQ :: (Functor m) => PQ db0 db1 m x -> PQ db0' db1' m x

327317unsafePQ (PQ pq) = PQ $ fmap (SOP.K . SOP.unK) . pq . SOP.K . SOP.unK

328318

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+24−17

@@ -64,6 +64,8 @@ module Squeal.PostgreSQL.PQ

6464 , resultErrorCode

6565 -- * Exceptions

6666 , SquealException (..)

67+ , PQState (..)

68+ , okResult

6769 , catchSqueal

6870 , handleSqueal

6971 ) where

@@ -398,7 +400,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

398400 Nothing -> throw $ ResultException

399401 "manipulateParams: LibPQ.execParams returned no results"

400402 Just result -> do

401− tryResult result

403+ okResult_ result

402404 return $ K (K result)

403405

404406 traversePrepared

@@ -409,7 +411,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

409411 case prepResultMaybe of

410412 Nothing -> throw $ ResultException

411413 "traversePrepared: LibPQ.prepare returned no results"

412− Just prepResult -> tryResult prepResult

414+ Just prepResult -> okResult_ prepResult

413415 results <- for list $ \ params -> do

414416 let

415417 toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

@@ -419,13 +421,13 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

419421 Nothing -> throw $ ResultException

420422 "traversePrepared: LibPQ.execParams returned no results"

421423 Just result -> do

422− tryResult result

424+ okResult_ result

423425 return $ K result

424426 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

425427 case deallocResultMaybe of

426428 Nothing -> throw $ ResultException

427429 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

428− Just deallocResult -> tryResult deallocResult

430+ Just deallocResult -> okResult_ deallocResult

429431 return (K results)

430432

431433 traversePrepared_

@@ -436,7 +438,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

436438 case prepResultMaybe of

437439 Nothing -> throw $ ResultException

438440 "traversePrepared_: LibPQ.prepare returned no results"

439− Just prepResult -> tryResult prepResult

441+ Just prepResult -> okResult_ prepResult

440442 for_ list $ \ params -> do

441443 let

442444 toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

@@ -445,12 +447,12 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

445447 case resultMaybe of

446448 Nothing -> throw $ ResultException

447449 "traversePrepared_: LibPQ.execParams returned no results"

448− Just result -> tryResult result

450+ Just result -> okResult_ result

449451 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

450452 case deallocResultMaybe of

451453 Nothing -> throw $ ResultException

452454 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

453− Just deallocResult -> tryResult deallocResult

455+ Just deallocResult -> okResult_ deallocResult

454456 return (K ())

455457

456458 liftPQ pq = PQ $ \ (K conn) -> do

@@ -613,24 +615,24 @@ resultErrorCode

613615 -> io (Maybe ByteString)

614616resultErrorCode = liftResult (flip LibPQ.resultErrorField LibPQ.DiagSqlstate)

615617

616−-- | `Exception`s that can be thrown by Squeal.

617−data SquealException

618− = PQException

618+-- | the state of LibPQ

619+data PQState = PQState

619620 { sqlExecStatus :: LibPQ.ExecStatus

620621 , sqlStateCode :: Maybe ByteString

621622 -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html

622623 , sqlErrorMessage :: Maybe ByteString

623− }

624+ } deriving (Eq, Show)

625+

626+-- | `Exception`s that can be thrown by Squeal.

627+data SquealException

628+ = PQException PQState

624629 | ResultException Text

625630 | ParseException Text

626631 deriving (Eq, Show)

627632instance Exception SquealException

628633

629−tryResult

630− :: MonadIO io

631− => LibPQ.Result

632− -> io ()

633−tryResult result = liftIO $ do

634+okResult_ :: MonadIO io => LibPQ.Result -> io ()

635+okResult_ result = liftIO $ do

634636 status <- LibPQ.resultStatus result

635637 case status of

636638 LibPQ.CommandOk -> return ()

@@ -638,7 +640,12 @@ tryResult result = liftIO $ do

638640 _ -> do

639641 stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

640642 msg <- LibPQ.resultErrorMessage result

641− throw $ PQException status stateCode msg

643+ throw . PQException $ PQState status stateCode msg

644+

645+-- | Check if a `Result`'s status is either `LibPQ.CommandOk`

646+-- or `LibPQ.TuplesOk` otherwise `throw` a `PQException`.

647+okResult :: MonadIO io => K LibPQ.Result row -> io ()

648+okResult = okResult_ . unK

642649

643650-- | Catch `SquealException`s.

644651catchSqueal

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+6−2

@@ -87,8 +87,12 @@ transactionallyRetry mode tx = mask $ \restore ->

8787 loop attempt = do

8888 begin mode

8989 attempt >>= \case

90− Left (PQException _ (Just "40001") _) -> rollback >> loop attempt

91− Left err -> rollback >> throwIO err

90+ Left (PQException (PQState _ (Just "40001") _)) -> do

91+ rollback

92+ loop attempt

93+ Left err -> do

94+ rollback

95+ throwIO err

9296 Right x -> return x

9397

9498-- | @BEGIN@ a transaction.

squeal-postgresql/test/Specs/ExceptionHandling.hs+1−1

@@ -114,7 +114,7 @@ specs = before_ setupDB $ after_ dropDB $

114114 describe "Exceptions" $ do

115115

116116 let

117− dupKeyErr = PQException FatalError (Just "23505")

117+ dupKeyErr = PQException $ PQState FatalError (Just "23505")

118118 (Just "ERROR: duplicate key value violates unique constraint \"unique_names\"\nDETAIL: Key (name)=(TestUser) already exists.\n")

119119

120120 it "should be thrown for unique constraint violation in a manipulation" $