Skip to content

Commit f743464

Browse files
ChrisPennerChrisPenner
committed
Set transaction modes for most codebase accesses
1 parent 6723733 commit f743464

6 files changed

Lines changed: 49 additions & 42 deletions

File tree

‎src/Share/Codebase.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ module Share.Codebase
77
( shorthashLength,
88
runCodebaseTransaction,
99
runCodebaseTransactionOrRespondError,
10+
runCodebaseTransactionModeOrRespondError,
1011
runCodebaseTransactionMode,
1112
tryRunCodebaseTransaction,
1213
tryRunCodebaseTransactionMode,
@@ -236,6 +237,12 @@ runCodebaseTransactionOrRespondError codebaseEnv m = do
236237
Left e -> respondError e
237238
Right a -> pure a
238239

240+
runCodebaseTransactionModeOrRespondError :: (ToServerError e, Loggable e) => PG.IsolationLevel -> PG.Mode -> CodebaseEnv -> CodebaseM e a -> WebApp a
241+
runCodebaseTransactionModeOrRespondError isoLevel mode codebaseEnv m = do
242+
tryRunCodebaseTransactionMode isoLevel mode codebaseEnv m >>= \case
243+
Left e -> respondError e
244+
Right a -> pure a
245+
239246
tryRunCodebaseTransactionMode :: (MonadReader (Env.Env x) m, MonadIO m) => PG.IsolationLevel -> PG.Mode -> CodebaseEnv -> CodebaseM e a -> m (Either e a)
240247
tryRunCodebaseTransactionMode isoLevel rwmode codebaseEnv m = do
241248
PG.tryRunTransactionMode isoLevel rwmode . codebaseMToTransaction codebaseEnv $ m

‎src/Share/Web/Share/Branches/Impl.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -124,7 +124,7 @@ projectBranchBrowseEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle pr
124124
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
125125
causalId <- resolveRootHash codebase branchHead rootHash
126126
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-browse" cacheParams causalId $ do
127-
Codebase.runCodebaseTransactionOrRespondError codebase $ do
127+
Codebase.runCodebaseTransactionModeOrRespondError PG.ReadCommitted PG.ReadWrite codebase $ do
128128
NL.serve causalId relativeTo namespace `whenNothingM` throwError (EntityMissing (ErrorID "namespace-not-found") "Namespace not found")
129129
where
130130
projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle = mayContributorHandle, branchName}
@@ -149,7 +149,7 @@ projectBranchDefinitionsByNameEndpoint (AuthN.MaybeAuthedUserID callerUserId) us
149149
causalId <- resolveRootHash codebase branchHead rootHash
150150
rt <- Codebase.codebaseRuntime codebase
151151
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definitions-by-name" cacheParams causalId $ do
152-
Codebase.runCodebaseTransaction codebase $ do
152+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
153153
ShareBackend.definitionForHQName (fromMaybe mempty relativeTo) causalId renderWidth (Suffixify False) rt name
154154
where
155155
projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName}
@@ -175,7 +175,7 @@ projectBranchDefinitionsByHashEndpoint (AuthN.MaybeAuthedUserID callerUserId) us
175175
causalId <- resolveRootHash codebase branchHead rootHash
176176
rt <- Codebase.codebaseRuntime codebase
177177
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definitions-by-hash" cacheParams causalId $ do
178-
Codebase.runCodebaseTransaction codebase $ do
178+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
179179
ShareBackend.definitionForHQName (fromMaybe mempty relativeTo) causalId renderWidth (Suffixify False) rt query
180180
where
181181
projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName}
@@ -199,7 +199,7 @@ projectBranchTermSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHand
199199
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
200200
causalId <- resolveRootHash codebase branchHead rootHash
201201
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-term-summary" cacheParams causalId $ do
202-
Codebase.runCodebaseTransaction codebase $ do
202+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
203203
serveTermSummary ref mayName causalId relativeTo renderWidth
204204
where
205205
projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName}
@@ -223,7 +223,7 @@ projectBranchTypeSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHand
223223
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
224224
causalId <- resolveRootHash codebase branchHead rootHash
225225
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-type-summary" cacheParams causalId $ do
226-
Codebase.runCodebaseTransaction codebase $ do
226+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
227227
serveTypeSummary ref mayName renderWidth
228228
where
229229
projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName}
@@ -248,7 +248,7 @@ projectBranchFindEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle proj
248248
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
249249
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
250250
causalId <- resolveRootHash codebase branchHead rootHash
251-
Codebase.runCodebaseTransaction codebase $ do
251+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
252252
Fuzzy.serveFuzzyFind inScratch searchDependencies causalId relativeTo limit renderWidth query
253253
where
254254
inScratch = False
@@ -271,7 +271,7 @@ projectBranchNamespacesByNameEndpoint (AuthN.MaybeAuthedUserID callerUserId) use
271271
causalId <- resolveRootHash codebase branchHead rootHash
272272
rt <- Codebase.codebaseRuntime codebase
273273
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-namespaces-by-name" cacheParams causalId $ do
274-
Codebase.runCodebaseTransactionOrRespondError codebase $ do
274+
Codebase.runCodebaseTransactionModeOrRespondError PG.ReadCommitted PG.ReadWrite codebase $ do
275275
ND.namespaceDetails rt (fromMaybe mempty path) causalId renderWidth
276276
`whenNothingM` throwError (EntityMissing (ErrorID "namespace-not-found") "Namespace not found")
277277
where
@@ -295,7 +295,7 @@ getProjectBranchReadmeEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle
295295
causalId <- resolveRootHash codebase branchHead rootHash
296296
rt <- Codebase.codebaseRuntime codebase
297297
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "get-project-branch-readme" cacheParams causalId $ do
298-
Codebase.runCodebaseTransaction codebase $ do
298+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
299299
mayNamespaceDetails <- ND.namespaceDetails rt rootPath causalId Nothing
300300
let mayReadme = do
301301
NamespaceDetails {readme} <- mayNamespaceDetails
@@ -374,7 +374,7 @@ getProjectBranchDocEndpoint cacheKey docNames (AuthN.MaybeAuthedUserID callerUse
374374
causalId <- resolveRootHash codebase branchHead rootHash
375375
rt <- Codebase.codebaseRuntime codebase
376376
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc cacheKey cacheParams causalId $ do
377-
Codebase.runCodebaseTransaction codebase $ do
377+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
378378
doc <- findAndRenderDoc docNames rt rootPath causalId Nothing
379379
pure $ DocResponse {doc}
380380
where
@@ -517,7 +517,7 @@ resolveRootHash :: Codebase.CodebaseEnv -> CausalId -> Maybe CausalHash -> WebAp
517517
resolveRootHash codebase branchHead rootHash = do
518518
case rootHash of
519519
Just rh -> do
520-
rootCausalId <- Codebase.runCodebaseTransaction codebase $ Codebase.expectCausalIdByHash rh
520+
rootCausalId <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase $ Codebase.expectCausalIdByHash rh
521521
AuthZ.assertCausalHashAccessibleFromRoot branchHead rootCausalId
522522
pure rootCausalId
523523
Nothing -> pure branchHead

‎src/Share/Web/Share/Impl.hs‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -125,9 +125,9 @@ browseEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle relativeTo name
125125
let codebaseLoc = Codebase.codebaseLocationForUserCodebase codebaseOwnerUserId
126126
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner namespacePrefix
127127
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
128-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
128+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase Codebase.expectLooseCodeRoot
129129
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "browse" cacheParams rootCausalId $ do
130-
Codebase.runCodebaseTransactionOrRespondError codebase $ do
130+
Codebase.runCodebaseTransactionModeOrRespondError PG.ReadCommitted PG.ReadWrite codebase $ do
131131
NL.serve rootCausalId relativeTo namespace `whenNothingM` throwError (EntityMissing (ErrorID "no-namespace") $ "No namespace found at " <> Path.toText namespacePrefix)
132132
where
133133
cacheParams = [tShow $ fromMaybe mempty relativeTo, tShow $ fromMaybe mempty namespace]
@@ -151,9 +151,9 @@ definitionsByNameEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle name
151151
let query = name
152152
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
153153
rt <- Codebase.codebaseRuntime codebase
154-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
154+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
155155
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "definitions-by-name" cacheParams rootCausalId $ do
156-
Codebase.runCodebaseTransaction codebase $ do
156+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
157157
ShareBackend.definitionForHQName (fromMaybe mempty relativeTo) rootCausalId renderWidth (Suffixify False) rt query
158158
where
159159
cacheParams = [HQ.toTextWith Name.toText name, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth]
@@ -181,9 +181,9 @@ definitionsByHashEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle refe
181181
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner authPath
182182
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
183183
rt <- Codebase.codebaseRuntime codebase
184-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
184+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
185185
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "definitions-by-hash" cacheParams rootCausalId $ do
186-
Codebase.runCodebaseTransaction codebase $ do
186+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
187187
ShareBackend.definitionForHQName (fromMaybe mempty relativeTo) rootCausalId renderWidth (Suffixify False) rt query
188188
where
189189
cacheParams = [toUrlPiece referent, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth]
@@ -203,9 +203,9 @@ termSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle ref mayNam
203203
let codebaseLoc = Codebase.codebaseLocationForUserCodebase codebaseOwnerUserId
204204
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner authPath
205205
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
206-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
206+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
207207
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "term-summary" cacheParams rootCausalId $ do
208-
Codebase.runCodebaseTransaction codebase $ do
208+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
209209
serveTermSummary ref mayName rootCausalId relativeTo renderWidth
210210
where
211211
cacheParams = [toUrlPiece ref, maybe "" Name.toText mayName, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth]
@@ -230,9 +230,9 @@ typeSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle ref mayNam
230230
let codebaseLoc = Codebase.codebaseLocationForUserCodebase codebaseOwnerUserId
231231
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner authPath
232232
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
233-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
233+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
234234
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "type-summary" cacheParams rootCausalId $ do
235-
Codebase.runCodebaseTransaction codebase $ do
235+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
236236
serveTypeSummary ref mayName renderWidth
237237
where
238238
cacheParams = [toUrlPiece ref, maybe "" Name.toText mayName, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth]
@@ -260,8 +260,8 @@ findEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle mayRelativeTo lim
260260
let codebaseLoc = Codebase.codebaseLocationForUserCodebase codebaseOwnerUserId
261261
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner authPath
262262
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
263-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
264-
Codebase.runCodebaseTransaction codebase $ do
263+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
264+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
265265
Fuzzy.serveFuzzyFind isInScratch searchDependencies rootCausalId relativeTo limit renderWidth query
266266
where
267267
isInScratch = True
@@ -280,9 +280,9 @@ namespacesByNameEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle (from
280280
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner path
281281
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
282282
rt <- Codebase.codebaseRuntime codebase
283-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
283+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
284284
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "namespaces-by-name" cacheParams rootCausalId $ do
285-
Codebase.runCodebaseTransactionOrRespondError codebase $ do
285+
Codebase.runCodebaseTransactionModeOrRespondError PG.ReadCommitted PG.ReadWrite codebase $ do
286286
ND.namespaceDetails rt path rootCausalId renderWidth `whenNothingM` throwError (EntityMissing (ErrorID "no-namespace") $ "No namespace found at " <> Path.toText path)
287287
where
288288
cacheParams = [tShow path]
@@ -334,9 +334,9 @@ getUserReadmeEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle = do
334334
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner path
335335
let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
336336
rt <- Codebase.codebaseRuntime codebase
337-
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransaction codebase Codebase.expectLooseCodeRoot
337+
(rootCausalId, _rootCausalHash) <- Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.Read codebase Codebase.expectLooseCodeRoot
338338
Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "get-user-readme" cacheParams rootCausalId $ do
339-
Codebase.runCodebaseTransaction codebase $ do
339+
Codebase.runCodebaseTransactionMode PG.ReadCommitted PG.ReadWrite codebase $ do
340340
mayNamespaceDetails <- ND.namespaceDetails rt path rootCausalId Nothing
341341
let mayReadme = do
342342
NamespaceDetails {readme} <- mayNamespaceDetails

0 commit comments

Comments
 (0)