547dff4 · denis · git.iko.soy

git.iko.soy/denis

on master help sign in

Fixed concurrent same transactions returning error

547dff4iko8 years ago

denis/package.yaml+2−1

compare with master

unifiedsplit

@@ -32,7 +32,8 @@ dependencies:

32- servant-websockets

33- websockets

34- squeal-postgresql

35−- transformers-base

35+# - transformers-base

36+- monad-control

36- generics-sop

37- generics-sop

37- containers

38- containers

38- mtl

39- mtl

denis/src/Data/Connection.hs+10−3

@@ -4,7 +4,8 @@

4 OverloadedLabels,

5 OverloadedStrings ,

6 TypeApplications ,

7− TypeOperators #-}

7+ TypeOperators,

8+ FlexibleContexts #-}

9module Data.Connection (

10module Data.Connection (

10 Connection,

11 Connection,

@@ -14,7 +15,8 @@ module Data.Connection (

14 runQnotFound,

15 runQnotFound,

15 runQerror,

16 runQerror,

16 maybeNotFound,

17 maybeNotFound,

17− maybeInvalidToken

18+ maybeInvalidToken,

19+ commitedTransactionallyUpdate

18) where

20) where

20import Squeal.PostgreSQL

22import Squeal.PostgreSQL

@@ -25,6 +27,9 @@ import Control.Monad.Reader

25import Control.Monad.Except

27import Control.Monad.Except

26import Servant.Server

28import Servant.Server

27import Server.Error

29import Server.Error

30+import Control.Monad.Trans.Control

31+import Squeal.PostgreSQL.Transaction

32+import Squeal.PostgreSQL.PQ

29type StaticPQ = PoolPQ Schema Handler

34type StaticPQ = PoolPQ Schema Handler

@@ -50,4 +55,6 @@ maybeInvalidToken :: App (Maybe a) -> App a

50maybeInvalidToken = (>>= (\t -> case t of

55maybeInvalidToken = (>>= (\t -> case t of

51 Just y -> return y

56 Just y -> return y

52 Nothing -> throwError invalidToken))

57 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]

309getAllUsers = runQuery getAllUsersQ >>= getRows

310

311publishPost :: UserId -> PostCreation -> StaticPQ PostId

312−-- publishPost uId pc = transactionally_ $ do

312+publishPost uId pc = commitedTransactionallyUpdate $ do

313−publishPost uId pc = do

314 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow

313 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow

315 case pId' of

314 case pId' of

316 (Just (Only pId)) -> do

315 (Just (Only pId)) -> do

@@ -319,15 +318,13 @@ publishPost uId pc = do

319 _ -> lift $ S.throwError S.err404

318 _ -> lift $ S.throwError S.err404

320

319

321createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)

320createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)

322−-- createNewChannel uId req = transactionally_ $ do

321+createNewChannel uId req = commitedTransactionallyUpdate $ do

323−createNewChannel uId req = do

324 uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req

322 uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req

325 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow

323 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow

326 return $ fmap fromOnly cId

324 return $ fmap fromOnly cId

327

325

328updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()

326updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()

329−-- updateChannel uId req = transactionally_ $ do

327+updateChannel uId req = commitedTransactionallyUpdate $ do

330−updateChannel uId req = do

331 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req

328 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req

332 _ <- getChannelForUser uId $ namedChannelId req

329 _ <- getChannelForUser uId $ namedChannelId req

333 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})

330 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})

@@ -350,8 +347,7 @@ getAllChannels uId = fmap (map removeUserFromChannel) $

350 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows

347 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows

351

348

352deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()

349deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()

353−-- deleteNamedChannel uId cId = transactionally_ $ do

350+deleteNamedChannel uId cId = commitedTransactionallyUpdate $ do

354−deleteNamedChannel uId cId = do

355 _ <- getChannelForUser uId cId

351 _ <- getChannelForUser uId cId

356 _ <- manipulateParams deleteNamedChannelQ (Only cId)

352 _ <- manipulateParams deleteNamedChannelQ (Only cId)

357 return ()

353 return ()

denis/src/Server/API/Channels.hs+4−1

@@ -24,6 +24,9 @@ import Servant.Docs (ToSample, toSamples, samples)

24import Server.LimitingRequest

25import Data.Channel.NamedChannel

26import Data.Channel.AnonymousChannel

27+

28+import Control.Monad.Reader (asks, lift)

29+import Squeal.PostgreSQL.Pool

28-- MARK: Implementation

31-- MARK: Implementation

@@ -54,7 +57,7 @@ createChannelApi uId req = maybeNotFound . runQnotFound $ createNewChannel uId r

55updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent

58updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent

56updateChannelApi uId req = do

59updateChannelApi uId req = do

57− runQ err500 $ updateChannel uId req

60+ runQnotFound $ updateChannel uId req

58 return NoContent

61 return NoContent

60deleteChannelApi :: UserId -> NamedChannelId -> App NoContent

63deleteChannelApi :: UserId -> NamedChannelId -> App NoContent