refactor: Remove Protolude.Conv from Middleware
This commit is contained in:
+13
-13
@@ -14,10 +14,11 @@ module PostgREST.Middleware
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BSL
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.DynamicStatements.Snippet as SQL hiding
|
import qualified Hasql.DynamicStatements.Snippet as SQL hiding
|
||||||
(sql)
|
(sql)
|
||||||
@@ -51,8 +52,7 @@ import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
|
|||||||
|
|
||||||
import PostgREST.Request.Preferences
|
import PostgREST.Request.Preferences
|
||||||
|
|
||||||
import Protolude hiding (head, toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||||
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
||||||
@@ -77,13 +77,13 @@ runPgLocals conf claims app req jsonDbS actualPgVersion = do
|
|||||||
let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
|
let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
|
||||||
M.union claims (M.singleton "role" anon)
|
M.union claims (M.singleton "role" anon)
|
||||||
claimsSql = if usesLegacyGucs
|
claimsSql = if usesLegacyGucs
|
||||||
then setConfigLocal "request.jwt.claim." <$> [(toS c, toS $ unquoted v) | (c,v) <- M.toList claimsWithRole]
|
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- M.toList claimsWithRole]
|
||||||
else [setConfigLocal mempty ("request.jwt.claims", BSL.toStrict $ JSON.encode claimsWithRole)]
|
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claimsWithRole)]
|
||||||
roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toS $ unquoted x)) <$> M.lookup "role" claimsWithRole
|
roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toUtf8 $ unquoted x)) <$> M.lookup "role" claimsWithRole
|
||||||
appSettingsSql = setConfigLocal mempty <$> (join bimap toS <$> configAppSettings conf)
|
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
|
||||||
searchPathSql =
|
searchPathSql =
|
||||||
let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
|
let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
|
||||||
setConfigLocal mempty ("search_path", toS schemas)
|
setConfigLocal mempty ("search_path", toUtf8 schemas)
|
||||||
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
|
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
|
||||||
specSql = case iTarget req of
|
specSql = case iTarget req of
|
||||||
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
|
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
|
||||||
@@ -151,15 +151,15 @@ corsPolicy req = case lookup "origin" headers of
|
|||||||
where
|
where
|
||||||
headers = Wai.requestHeaders req
|
headers = Wai.requestHeaders req
|
||||||
accHeaders = case lookup "access-control-request-headers" headers of
|
accHeaders = case lookup "access-control-request-headers" headers of
|
||||||
Just hdrs -> map (CI.mk . toS . T.strip . toS) $ BS.split ',' hdrs
|
Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs
|
||||||
Nothing -> []
|
Nothing -> []
|
||||||
|
|
||||||
unquoted :: JSON.Value -> Text
|
unquoted :: JSON.Value -> Text
|
||||||
unquoted (JSON.String t) = t
|
unquoted (JSON.String t) = t
|
||||||
unquoted (JSON.Number n) =
|
unquoted (JSON.Number n) =
|
||||||
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
||||||
unquoted (JSON.Bool b) = show b
|
unquoted (JSON.Bool b) = show b
|
||||||
unquoted v = toS $ JSON.encode v
|
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||||
|
|
||||||
-- | Set a transaction to eventually roll back if requested and set respective
|
-- | Set a transaction to eventually roll back if requested and set respective
|
||||||
-- headers on the response.
|
-- headers on the response.
|
||||||
@@ -199,6 +199,6 @@ setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
|
|||||||
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
||||||
where
|
where
|
||||||
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
||||||
gucJsonVal = BSL.toStrict . JSON.encode . M.fromList . arrayByteStringToText
|
gucJsonVal = LBS.toStrict . JSON.encode . M.fromList . arrayByteStringToText
|
||||||
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
|
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
|
||||||
arrayByteStringToText keyVal = (toS *** toS) <$> keyVal
|
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
|
||||||
|
|||||||
Reference in New Issue
Block a user