git.iko.soy/denis
on master help sign in
Fixed concurrent same transactions returning error
commit547dff4e24f4addca75a5bc8806a628acbfb0b47 authoriko <ilyakooo0@gmail.com> dateSat 13 Apr 2019, 23:12 (8 years ago) parent3e2f1c8
4 files changed+20−13
compare with master
unifiedsplit
denis/package.yaml+2−1 denis/src/Data/Connection.hs+10−3 denis/src/Data/Query.hs+4−8 denis/src/Server/API/Channels.hs+4−1
denis/package.yaml+2−1
@@ -32,7 +32,8 @@ dependencies:
3232- servant-websockets
3333- websockets
3434- squeal-postgresql
35−- transformers-base
35+# - transformers-base
36+- monad-control
3637- generics-sop
3738- containers
3839- mtl
denis/src/Data/Connection.hs+10−3
@@ -4,7 +4,8 @@
44 OverloadedLabels,
55 OverloadedStrings ,
66 TypeApplications ,
7− TypeOperators #-}
7+ TypeOperators,
8+ FlexibleContexts #-}
89
910module Data.Connection (
1011 Connection,
@@ -14,7 +15,8 @@ module Data.Connection (
1415 runQnotFound,
1516 runQerror,
1617 maybeNotFound,
17− maybeInvalidToken
18+ maybeInvalidToken,
19+ commitedTransactionallyUpdate
1820) where
1921
2022import Squeal.PostgreSQL
@@ -25,6 +27,9 @@ import Control.Monad.Reader
2527import Control.Monad.Except
2628import Servant.Server
2729import Server.Error
30+import Control.Monad.Trans.Control
31+import Squeal.PostgreSQL.Transaction
32+import Squeal.PostgreSQL.PQ
2833
2934type StaticPQ = PoolPQ Schema Handler
3035
@@ -50,4 +55,6 @@ maybeInvalidToken :: App (Maybe a) -> App a
5055maybeInvalidToken = (>>= (\t -> case t of
5156 Just y -> return y
5257 Nothing -> throwError invalidToken))
53−
58+
59+commitedTransactionallyUpdate :: (MonadBaseControl IO tx, MonadPQ schema tx) => tx x -> tx x
60+commitedTransactionallyUpdate = transactionally $ TransactionMode ReadCommitted ReadWrite NotDeferrable
denis/src/Data/Query.hs+4−8
@@ -309,8 +309,7 @@ getAllUsers :: StaticPQ [User]
309309getAllUsers = runQuery getAllUsersQ >>= getRows
310310
311311publishPost :: UserId -> PostCreation -> StaticPQ PostId
312−-- publishPost uId pc = transactionally_ $ do
313−publishPost uId pc = do
312+publishPost uId pc = commitedTransactionallyUpdate $ do
314313 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
315314 case pId' of
316315 (Just (Only pId)) -> do
@@ -319,15 +318,13 @@ publishPost uId pc = do
319318 _ -> lift $ S.throwError S.err404
320319
321320createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
322−-- createNewChannel uId req = transactionally_ $ do
323−createNewChannel uId req = do
321+createNewChannel uId req = commitedTransactionallyUpdate $ do
324322 uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req
325323 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
326324 return $ fmap fromOnly cId
327325
328326updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
329−-- updateChannel uId req = transactionally_ $ do
330−updateChannel uId req = do
327+updateChannel uId req = commitedTransactionallyUpdate $ do
331328 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
332329 _ <- getChannelForUser uId $ namedChannelId req
333330 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
@@ -350,8 +347,7 @@ getAllChannels uId = fmap (map removeUserFromChannel) $
350347 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows
351348
352349deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()
353−-- deleteNamedChannel uId cId = transactionally_ $ do
354−deleteNamedChannel uId cId = do
350+deleteNamedChannel uId cId = commitedTransactionallyUpdate $ do
355351 _ <- getChannelForUser uId cId
356352 _ <- manipulateParams deleteNamedChannelQ (Only cId)
357353 return ()
denis/src/Server/API/Channels.hs+4−1
@@ -24,6 +24,9 @@ import Servant.Docs (ToSample, toSamples, samples)
2424import Server.LimitingRequest
2525import Data.Channel.NamedChannel
2626import Data.Channel.AnonymousChannel
27+
28+import Control.Monad.Reader (asks, lift)
29+import Squeal.PostgreSQL.Pool
2730
2831-- MARK: Implementation
2932
@@ -54,7 +57,7 @@ createChannelApi uId req = maybeNotFound . runQnotFound $ createNewChannel uId r
5457
5558updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent
5659updateChannelApi uId req = do
57− runQ err500 $ updateChannel uId req
60+ runQnotFound $ updateChannel uId req
5861 return NoContent
5962
6063deleteChannelApi :: UserId -> NamedChannelId -> App NoContent