Fix #1141, app.settings resetting on pool timeout (#1169)

* Add test for ensuring app.settings don't reset

src/PostgREST/Config.hs

@@ -141,7 +141,7 @@ readOptions = do
           <*> (join . fmap coerceInt <$> C.key "max-rows")
           <*> (mfilter (/= "") <$> C.key "pre-request")
           <*> pure False
-          <*> (fmap parsedPairToTextPair <$> C.subassocs "app.settings")
+          <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")
           <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
 
   case mAppConf of
@@ -152,13 +152,6 @@ readOptions = do
       return appConf
 
   where
-    parsedPairToTextPair :: (Name, Value) -> (Text, Text)
-    parsedPairToTextPair (k, v) = (k, newValue)
-      where
-        newValue = case v of
-          String textVal -> textVal
-          _ -> show v
-
     parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
     parseJwtAudience k =
       C.key k >>= \case
@@ -168,6 +161,10 @@ readOptions = do
           (Just "") -> pure Nothing
           aud' -> pure aud'
 
+    coerceText :: Value -> Text
+    coerceText (String s) = s
+    coerceText v = show v
+
     coerceInt :: (Read i, Integral i) => Value -> Maybe i
     coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
     coerceInt (String x) = readMaybe $ toS x

src/PostgREST/DbStructure.hs

@@ -10,7 +10,6 @@ module PostgREST.DbStructure (
 , accessibleProcs
 , schemaDescription
 , getPgVersion
-, fillSessionWithSettings
 ) where
 
 import qualified Hasql.Decoders                as HD
@@ -33,9 +32,6 @@ import           GHC.Exts                      (groupWith)
 import           Protolude
 import           Unsafe (unsafeHead)
 
-import           Data.Functor.Contravariant    (contramap)
-import           Contravariant.Extras          (contrazip2)
-
 getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
 getDbStructure schema pgVer = do
   tabs      <- H.query () allTables
@@ -764,17 +760,3 @@ getPgVersion = H.query () $ H.statement sql HE.unit versionRow False
   where
     sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
     versionRow = HD.singleRow $ PgVersion <$> HD.value HD.int4 <*> HD.value HD.text
-
-fillSessionWithSettings :: [(Text, Text)] -> H.Session ()
-fillSessionWithSettings settings =
-    -- Send all of the config settings to the set_config function, using pgsql's `unnest` to transform arrays of values
-    H.query settings $ H.statement "SELECT set_config(k, v, false) FROM unnest($1, $2) AS f1(k, v)" encoder HD.unit False
-
-  where
-    -- Take a list of (key, value) pairs and encode each as an array to later bind to the query
-    -- see Insert Many section at https://hackage.haskell.org/package/hasql-1.1.1/docs/Hasql-Encoders.html
-    encoder = contramap L.unzip $ contrazip2 (vector HE.text) (vector HE.text)
-      where
-        vector value =
-          HE.value $ HE.array $ HE.arrayDimension foldl' $ HE.arrayValue value
-

src/PostgREST/Middleware.hs

@@ -19,7 +19,7 @@ import           PostgREST.ApiRequest          (ApiRequest(..))
 import           PostgREST.Auth                (JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (simpleError)
-import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)
+import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtSetLocal)
 
 import           Protolude                     hiding (concat, null)
 
@@ -32,13 +32,14 @@ runWithClaims conf eClaims app req =
     JWTInvalid e -> return $ unauthed $ show e
     JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
     JWTClaims claims -> do
-      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
+      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql
       mapM_ H.sql customReqCheck
       app req
       where
-        headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req
-        cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req
-        claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        headersSql = pgFmtSetLocal "request.header." <$> iHeaders req
+        cookiesSql = pgFmtSetLocal "request.cookie." <$> iCookies req
+        claimsSql = pgFmtSetLocal "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        appSettingsSql = pgFmtSetLocal mempty <$> configSettings conf
         setRoleSql = maybeToList $
           (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
         setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]

src/PostgREST/QueryBuilder.hs

@@ -23,7 +23,7 @@ module PostgREST.QueryBuilder (
   , requestToCountQuery
   , unquoted
   , ResultsWithCount
-  , pgFmtEnvVar
+  , pgFmtSetLocal
   ) where
 
 import qualified Hasql.Query             as H
@@ -469,8 +469,8 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
   Nothing -> ""
 pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
 
-pgFmtEnvVar :: Text -> (Text, Text) -> SqlFragment
-pgFmtEnvVar prefix (k, v) =
+pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment
+pgFmtSetLocal prefix (k, v) =
   "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
 
 trimNullChars :: Text -> Text