@@ -12,6 +12,7 @@ Description : Manages PostgREST configuration type and parser.
1212
1313module PostgREST.Config
1414 ( AppConfig (.. )
15+ , DbTxEnd (.. )
1516 , Environment
1617 , JSPath
1718 , JSPathExp (.. )
@@ -88,8 +89,7 @@ data AppConfig = AppConfig
8889 , configDbSchemas :: NonEmpty Text
8990 , configDbConfig :: Bool
9091 , configDbPreConfig :: Maybe QualifiedIdentifier
91- , configDbTxAllowOverride :: Bool
92- , configDbTxRollbackAll :: Bool
92+ , configDbTxEnd :: DbTxEnd
9393 , configDbUri :: Text
9494 , configFilePath :: Maybe FilePath
9595 , configJWKS :: Maybe JwkSet
@@ -117,6 +117,13 @@ data AppConfig = AppConfig
117117 , configInternalSCSleep :: Maybe Int32
118118 }
119119
120+ data DbTxEnd
121+ = TxCommit
122+ | TxCommitAllowOverride
123+ | TxRollback
124+ | TxRollbackAllowOverride
125+ deriving (Eq )
126+
120127data LogLevel = LogCrit | LogError | LogWarn | LogInfo | LogDebug
121128 deriving (Eq , Ord )
122129
@@ -171,7 +178,7 @@ toText conf =
171178 ,(" db-schemas" , q . T. intercalate " ," . toList . configDbSchemas)
172179 ,(" db-config" , T. toLower . show . configDbConfig)
173180 ,(" db-pre-config" , q . maybe mempty dumpQi . configDbPreConfig)
174- ,(" db-tx-end" , q . showTxEnd)
181+ ,(" db-tx-end" , q . showTxEnd . configDbTxEnd )
175182 ,(" db-uri" , q . configDbUri)
176183 ,(" jwt-aud" , q . fromMaybe mempty . configJwtAudience)
177184 ,(" jwt-role-claim-key" , q . T. intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
@@ -200,16 +207,19 @@ toText conf =
200207 -- quote strings and replace " with \"
201208 q s = " \" " <> T. replace " \" " " \\\" " s <> " \" "
202209
203- showTxEnd c = case (configDbTxRollbackAll c, configDbTxAllowOverride c) of
204- ( False , False ) -> " commit"
205- ( False , True ) -> " commit-allow-override"
206- ( True , False ) -> " rollback"
207- ( True , True ) -> " rollback-allow-override"
210+ showTxEnd :: DbTxEnd -> Text
211+ showTxEnd = \ case
212+ TxCommit -> " commit"
213+ TxCommitAllowOverride -> " commit-allow-override"
214+ TxRollback -> " rollback"
215+ TxRollbackAllowOverride -> " rollback-allow-override"
216+
208217 showJwtSecret c
209218 | configJwtSecretIsBase64 c = B64. encode secret
210219 | otherwise = secret
211220 where
212221 secret = fromMaybe mempty $ configJwtSecret c
222+
213223 showSocketMode c = showOct (configServerUnixSocketMode c) mempty
214224
215225-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
@@ -276,8 +286,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
276286 (optString " db-schema" ))
277287 <*> (fromMaybe True <$> optBool " db-config" )
278288 <*> (fmap toQi <$> optString " db-pre-config" )
279- <*> parseTxEnd " db-tx-end" snd
280- <*> parseTxEnd " db-tx-end" fst
289+ <*> parseTxEnd " db-tx-end"
281290 <*> (fromMaybe " postgresql://" <$> optString " db-uri" )
282291 <*> pure optPath
283292 <*> pure Nothing
@@ -373,15 +382,14 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
373382 Just " main-query" -> pure LogQueryMain
374383 Just _ -> fail " Invalid SQL logging value. Check your configuration."
375384
376- parseTxEnd :: C. Key -> (( Bool , Bool ) -> Bool ) -> C. Parser C. Config Bool
377- parseTxEnd k f =
385+ parseTxEnd :: C. Key -> C. Parser C. Config DbTxEnd
386+ parseTxEnd k =
378387 optString k >>= \ case
379- -- RollbackAll AllowOverride
380- Nothing -> pure $ f (False , False )
381- Just " commit" -> pure $ f (False , False )
382- Just " commit-allow-override" -> pure $ f (False , True )
383- Just " rollback" -> pure $ f (True , False )
384- Just " rollback-allow-override" -> pure $ f (True , True )
388+ Nothing -> pure TxCommit -- default
389+ Just " commit" -> pure TxCommit
390+ Just " commit-allow-override" -> pure TxCommitAllowOverride
391+ Just " rollback" -> pure TxRollback
392+ Just " rollback-allow-override" -> pure TxRollbackAllowOverride
385393 Just _ -> fail " Invalid transaction termination. Check your configuration."
386394
387395 parseRoleClaimKey :: C. Key -> C. Key -> C. Parser C. Config JSPath
0 commit comments