refactor: move logStdout/corsPolicy to Middleware
* remove configQuiet from Config configQuiet was not an end user setting. The logging setup is now an internal parameter. * move proxy uri validation to Private dir
This commit is contained in:
committed by
Steve Chavez
parent
0ff05edd16
commit
e272ea47be
+6
-2
@@ -30,13 +30,16 @@ import System.IO (BufferMode (..), hSetBuffering)
|
|||||||
import PostgREST.App (postgrest)
|
import PostgREST.App (postgrest)
|
||||||
import PostgREST.Auth (parseSecret)
|
import PostgREST.Auth (parseSecret)
|
||||||
import PostgREST.Config (AppConfig (..), configPoolTimeout',
|
import PostgREST.Config (AppConfig (..), configPoolTimeout',
|
||||||
prettyVersion, readAppConfig, readPathShowHelp, loadDbUriFile, loadSecretFile)
|
loadDbUriFile, loadSecretFile,
|
||||||
|
prettyVersion, readAppConfig,
|
||||||
|
readPathShowHelp)
|
||||||
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
||||||
import PostgREST.Error (PgError (PgError), checkIsFatal,
|
import PostgREST.Error (PgError (PgError), checkIsFatal,
|
||||||
errorPayload)
|
errorPayload)
|
||||||
import PostgREST.OpenAPI (isMalformedProxyUri)
|
import PostgREST.OpenAPI (isMalformedProxyUri)
|
||||||
import PostgREST.Types (ConnectionStatus (..), DbStructure,
|
import PostgREST.Types (ConnectionStatus (..), DbStructure,
|
||||||
PgVersion (..), minimumPgVersion)
|
LogSetup (..), PgVersion (..),
|
||||||
|
minimumPgVersion)
|
||||||
import Protolude hiding (hPutStrLn, head, toS)
|
import Protolude hiding (hPutStrLn, head, toS)
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
@@ -284,6 +287,7 @@ main = do
|
|||||||
|
|
||||||
let postgrestApplication =
|
let postgrestApplication =
|
||||||
postgrest
|
postgrest
|
||||||
|
LogStdout
|
||||||
conf
|
conf
|
||||||
refDbStructure
|
refDbStructure
|
||||||
pool
|
pool
|
||||||
|
|||||||
@@ -41,6 +41,7 @@ library
|
|||||||
PostgREST.Types
|
PostgREST.Types
|
||||||
other-modules: Paths_postgrest
|
other-modules: Paths_postgrest
|
||||||
PostgREST.Private.Common
|
PostgREST.Private.Common
|
||||||
|
PostgREST.Private.ProxyUri
|
||||||
PostgREST.Private.QueryFragment
|
PostgREST.Private.QueryFragment
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
build-depends: base >= 4.9 && < 4.15
|
build-depends: base >= 4.9 && < 4.15
|
||||||
|
|||||||
@@ -27,11 +27,9 @@ import qualified Hasql.Transaction as H
|
|||||||
import qualified Hasql.Transaction as HT
|
import qualified Hasql.Transaction as HT
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
import qualified Hasql.Transaction.Sessions as HT
|
||||||
|
|
||||||
import Data.Function (id)
|
import Data.IORef (IORef, readIORef)
|
||||||
import Data.IORef (IORef, readIORef)
|
import Data.Time.Clock (UTCTime)
|
||||||
import Data.Time.Clock (UTCTime)
|
import Network.HTTP.Types.URI (renderSimpleQuery)
|
||||||
import Network.HTTP.Types.URI (renderSimpleQuery)
|
|
||||||
import Network.Wai.Middleware.RequestLogger (logStdout)
|
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@@ -67,10 +65,9 @@ import PostgREST.Types
|
|||||||
import Protolude hiding (Proxy, intercalate, toS)
|
import Protolude hiding (Proxy, intercalate, toS)
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
|
postgrest :: LogSetup -> AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
|
||||||
postgrest conf refDbStructure pool getTime worker =
|
postgrest logs conf refDbStructure pool getTime worker =
|
||||||
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
|
pgrstMiddleware logs $ \ req respond -> do
|
||||||
middle $ \ req respond -> do
|
|
||||||
time <- getTime
|
time <- getTime
|
||||||
body <- strictRequestBody req
|
body <- strictRequestBody req
|
||||||
maybeDbStructure <- readIORef refDbStructure
|
maybeDbStructure <- readIORef refDbStructure
|
||||||
|
|||||||
+18
-50
@@ -21,7 +21,6 @@ module PostgREST.Config ( prettyVersion
|
|||||||
, docsVersion
|
, docsVersion
|
||||||
, readPathShowHelp
|
, readPathShowHelp
|
||||||
, readAppConfig
|
, readAppConfig
|
||||||
, corsPolicy
|
|
||||||
, AppConfig (..)
|
, AppConfig (..)
|
||||||
, configPoolTimeout'
|
, configPoolTimeout'
|
||||||
, loadSecretFile
|
, loadSecretFile
|
||||||
@@ -29,35 +28,30 @@ module PostgREST.Config ( prettyVersion
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Crypto.JWT (JWKSet)
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Base64 as B64
|
import qualified Data.ByteString.Base64 as B64
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.CaseInsensitive as CI
|
|
||||||
import qualified Data.Configurator as C
|
import qualified Data.Configurator as C
|
||||||
import qualified Text.PrettyPrint.ANSI.Leijen as L
|
import qualified Text.PrettyPrint.ANSI.Leijen as L
|
||||||
|
|
||||||
import Control.Lens (preview)
|
import Control.Lens (preview)
|
||||||
import Control.Monad (fail)
|
import Control.Monad (fail)
|
||||||
import Crypto.JWT (StringOrURI, stringOrUri)
|
import Crypto.JWT (JWKSet, StringOrURI, stringOrUri)
|
||||||
import Data.List (lookup)
|
import Data.List.NonEmpty (fromList)
|
||||||
import Data.List.NonEmpty (fromList)
|
import Data.Scientific (floatingOrInteger)
|
||||||
import Data.Scientific (floatingOrInteger)
|
import Data.Text (dropEnd, dropWhileEnd, intercalate, pack,
|
||||||
import Data.Text (pack, replace, dropEnd, dropWhileEnd,
|
replace, splitOn, strip, stripPrefix, take,
|
||||||
intercalate, splitOn, strip, stripPrefix, take,
|
unpack)
|
||||||
unpack)
|
import Data.Text.IO (hPutStrLn)
|
||||||
import Data.Text.IO (hPutStrLn)
|
import Data.Version (versionBranch)
|
||||||
import Data.Version (versionBranch)
|
import Development.GitRev (gitHash)
|
||||||
import Development.GitRev (gitHash)
|
import Numeric (readOct)
|
||||||
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
|
import Paths_postgrest (version)
|
||||||
import Numeric (readOct)
|
import System.IO.Error (IOError)
|
||||||
import Paths_postgrest (version)
|
import System.Posix.Types (FileMode)
|
||||||
import System.IO.Error (IOError)
|
|
||||||
import System.Posix.Types (FileMode)
|
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Network.Wai
|
|
||||||
import Options.Applicative hiding (str)
|
import Options.Applicative hiding (str)
|
||||||
import Text.Heredoc
|
import Text.Heredoc
|
||||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
|
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
|
||||||
@@ -65,7 +59,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
|
|||||||
import PostgREST.Parsers (pRoleClaimKey)
|
import PostgREST.Parsers (pRoleClaimKey)
|
||||||
import PostgREST.Types (JSPath, JSPathExp (..))
|
import PostgREST.Types (JSPath, JSPathExp (..))
|
||||||
import Protolude hiding (concat, hPutStrLn, intercalate, null,
|
import Protolude hiding (concat, hPutStrLn, intercalate, null,
|
||||||
take, toS, (<>), replace)
|
replace, take, toS, (<>))
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
|
|
||||||
@@ -89,8 +83,7 @@ data AppConfig = AppConfig {
|
|||||||
, configPoolSize :: Int
|
, configPoolSize :: Int
|
||||||
, configPoolTimeout :: Int
|
, configPoolTimeout :: Int
|
||||||
, configMaxRows :: Maybe Integer
|
, configMaxRows :: Maybe Integer
|
||||||
, configReqCheck :: Maybe Text
|
, configPreReq :: Maybe Text
|
||||||
, configQuiet :: Bool
|
|
||||||
, configSettings :: [(Text, Text)]
|
, configSettings :: [(Text, Text)]
|
||||||
, configRoleClaimKey :: Either Text JSPath
|
, configRoleClaimKey :: Either Text JSPath
|
||||||
, configExtraSearchPath :: [Text]
|
, configExtraSearchPath :: [Text]
|
||||||
@@ -105,30 +98,6 @@ configPoolTimeout' :: (Fractional a) => AppConfig -> a
|
|||||||
configPoolTimeout' =
|
configPoolTimeout' =
|
||||||
fromRational . toRational . configPoolTimeout
|
fromRational . toRational . configPoolTimeout
|
||||||
|
|
||||||
|
|
||||||
defaultCorsPolicy :: CorsResourcePolicy
|
|
||||||
defaultCorsPolicy = CorsResourcePolicy Nothing
|
|
||||||
["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
|
|
||||||
(Just $ 60*60*24) False False True
|
|
||||||
|
|
||||||
-- | CORS policy to be used in by Wai Cors middleware
|
|
||||||
corsPolicy :: Request -> Maybe CorsResourcePolicy
|
|
||||||
corsPolicy req = case lookup "origin" headers of
|
|
||||||
Just origin -> Just defaultCorsPolicy {
|
|
||||||
corsOrigins = Just ([origin], True)
|
|
||||||
, corsRequestHeaders = "Authentication":accHeaders
|
|
||||||
, corsExposedHeaders = Just [
|
|
||||||
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
|
||||||
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
|
|
||||||
]
|
|
||||||
}
|
|
||||||
Nothing -> Nothing
|
|
||||||
where
|
|
||||||
headers = requestHeaders req
|
|
||||||
accHeaders = case lookup "access-control-request-headers" headers of
|
|
||||||
Just hdrs -> map (CI.mk . toS . strip . toS) $ BS.split ',' hdrs
|
|
||||||
Nothing -> []
|
|
||||||
|
|
||||||
-- | User friendly version number
|
-- | User friendly version number
|
||||||
prettyVersion :: Text
|
prettyVersion :: Text
|
||||||
prettyVersion =
|
prettyVersion =
|
||||||
@@ -257,7 +226,6 @@ readAppConfig cfgPath = do
|
|||||||
<*> (fromMaybe 10 <$> optInt "db-pool-timeout")
|
<*> (fromMaybe 10 <$> optInt "db-pool-timeout")
|
||||||
<*> optInt "max-rows"
|
<*> optInt "max-rows"
|
||||||
<*> optString "pre-request"
|
<*> optString "pre-request"
|
||||||
<*> pure False
|
|
||||||
<*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
|
<*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
|
||||||
<*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
|
<*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
|
||||||
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
|
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
|
||||||
|
|||||||
+49
-16
@@ -1,6 +1,6 @@
|
|||||||
{-|
|
{-|
|
||||||
Module : PostgREST.Middleware
|
Module : PostgREST.Middleware
|
||||||
Description : Sets the PostgreSQL GUCs, role, search_path and pre-request function. Validates JWT.
|
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
|
||||||
-}
|
-}
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
@@ -8,20 +8,29 @@ Description : Sets the PostgreSQL GUCs, role, search_path and pre-request functi
|
|||||||
|
|
||||||
module PostgREST.Middleware where
|
module PostgREST.Middleware where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import Data.Scientific (FPFormat (..), formatScientific,
|
import qualified Data.CaseInsensitive as CI
|
||||||
isInteger)
|
import Data.Function (id)
|
||||||
import qualified Hasql.Transaction as H
|
import qualified Data.HashMap.Strict as M
|
||||||
|
import Data.List (lookup)
|
||||||
|
import Data.Scientific (FPFormat (..),
|
||||||
|
formatScientific, isInteger)
|
||||||
|
import Data.Text (strip)
|
||||||
|
import qualified Hasql.Transaction as H
|
||||||
|
|
||||||
import Network.Wai (Application, Response)
|
import Network.Wai (Application, Request,
|
||||||
import Network.Wai.Middleware.Cors (cors)
|
Response, requestHeaders)
|
||||||
import Network.Wai.Middleware.Gzip (def, gzip)
|
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..),
|
||||||
import Network.Wai.Middleware.Static (only, staticPolicy)
|
cors)
|
||||||
|
import Network.Wai.Middleware.Gzip (def, gzip)
|
||||||
|
import Network.Wai.Middleware.RequestLogger (logStdout)
|
||||||
|
import Network.Wai.Middleware.Static (only, staticPolicy)
|
||||||
|
|
||||||
import PostgREST.ApiRequest (ApiRequest (..))
|
import PostgREST.ApiRequest (ApiRequest (..))
|
||||||
import PostgREST.Config (AppConfig (..), corsPolicy)
|
import PostgREST.Config (AppConfig (..))
|
||||||
import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
|
import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
|
||||||
|
import PostgREST.Types (LogSetup (..))
|
||||||
import Protolude hiding (head, toS)
|
import Protolude hiding (head, toS)
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
@@ -31,7 +40,7 @@ runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
|||||||
ApiRequest -> H.Transaction Response
|
ApiRequest -> H.Transaction Response
|
||||||
runPgLocals conf claims app req = do
|
runPgLocals conf claims app req = do
|
||||||
H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql
|
H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql
|
||||||
traverse_ H.sql customReqCheck
|
traverse_ H.sql preReq
|
||||||
app req
|
app req
|
||||||
where
|
where
|
||||||
methodSql = setLocalQuery mempty ("request.method", toS $ iMethod req)
|
methodSql = setLocalQuery mempty ("request.method", toS $ iMethod req)
|
||||||
@@ -46,14 +55,38 @@ runPgLocals conf claims app req = do
|
|||||||
-- role claim defaults to anon if not specified in jwt
|
-- role claim defaults to anon if not specified in jwt
|
||||||
claimsWithRole = M.union claims (M.singleton "role" anon)
|
claimsWithRole = M.union claims (M.singleton "role" anon)
|
||||||
anon = JSON.String . toS $ configAnonRole conf
|
anon = JSON.String . toS $ configAnonRole conf
|
||||||
customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
|
preReq = (\f -> "select " <> toS f <> "();") <$> configPreReq conf
|
||||||
|
|
||||||
defaultMiddle :: Application -> Application
|
pgrstMiddleware :: LogSetup -> Application -> Application
|
||||||
defaultMiddle =
|
pgrstMiddleware logs =
|
||||||
gzip def
|
(if logs == LogQuiet then id else logStdout)
|
||||||
|
. gzip def
|
||||||
. cors corsPolicy
|
. cors corsPolicy
|
||||||
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
|
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
|
||||||
|
|
||||||
|
defaultCorsPolicy :: CorsResourcePolicy
|
||||||
|
defaultCorsPolicy = CorsResourcePolicy Nothing
|
||||||
|
["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
|
||||||
|
(Just $ 60*60*24) False False True
|
||||||
|
|
||||||
|
-- | CORS policy to be used in by Wai Cors middleware
|
||||||
|
corsPolicy :: Request -> Maybe CorsResourcePolicy
|
||||||
|
corsPolicy req = case lookup "origin" headers of
|
||||||
|
Just origin -> Just defaultCorsPolicy {
|
||||||
|
corsOrigins = Just ([origin], True)
|
||||||
|
, corsRequestHeaders = "Authentication":accHeaders
|
||||||
|
, corsExposedHeaders = Just [
|
||||||
|
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
||||||
|
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
Nothing -> Nothing
|
||||||
|
where
|
||||||
|
headers = requestHeaders req
|
||||||
|
accHeaders = case lookup "access-control-request-headers" headers of
|
||||||
|
Just hdrs -> map (CI.mk . toS . strip . toS) $ BS.split ',' hdrs
|
||||||
|
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) =
|
||||||
|
|||||||
+12
-66
@@ -6,8 +6,8 @@ Description : Generates the OpenAPI output
|
|||||||
|
|
||||||
module PostgREST.OpenAPI (
|
module PostgREST.OpenAPI (
|
||||||
encodeOpenAPI
|
encodeOpenAPI
|
||||||
, isMalformedProxyUri
|
|
||||||
, pickProxy
|
, pickProxy
|
||||||
|
, isMalformedProxyUri
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.HashSet.InsOrd as Set
|
import qualified Data.HashSet.InsOrd as Set
|
||||||
@@ -20,20 +20,21 @@ import Data.String (IsString (..))
|
|||||||
import Data.Text (append, breakOn, dropWhile, init,
|
import Data.Text (append, breakOn, dropWhile, init,
|
||||||
intercalate, pack, tail, toLower,
|
intercalate, pack, tail, toLower,
|
||||||
unpack)
|
unpack)
|
||||||
import Network.URI (URI (..), URIAuth (..),
|
import Network.URI (URI (..), URIAuth (..))
|
||||||
isAbsoluteURI, parseURI)
|
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Swagger
|
import Data.Swagger
|
||||||
|
|
||||||
import PostgREST.ApiRequest (ContentType (..))
|
import PostgREST.ApiRequest (ContentType (..))
|
||||||
import PostgREST.Config (docsVersion, prettyVersion)
|
import PostgREST.Config (docsVersion, prettyVersion)
|
||||||
import PostgREST.Types (Column (..), ForeignKey (..), PgArg (..),
|
import PostgREST.Private.ProxyUri (isMalformedProxyUri, toURI)
|
||||||
PrimaryKey (..), ProcDescription (..),
|
import PostgREST.Types (Column (..), ForeignKey (..),
|
||||||
Proxy (..), Table (..), toMime)
|
PgArg (..), PrimaryKey (..),
|
||||||
import Protolude hiding (Proxy, dropWhile, get,
|
ProcDescription (..), Proxy (..),
|
||||||
intercalate, toLower, toS, (&))
|
Table (..), toMime)
|
||||||
import Protolude.Conv (toS)
|
import Protolude hiding (Proxy, dropWhile, get,
|
||||||
|
intercalate, toLower, toS, (&))
|
||||||
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
makeMimeList :: [ContentType] -> MimeList
|
makeMimeList :: [ContentType] -> MimeList
|
||||||
makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
|
makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
|
||||||
@@ -306,24 +307,6 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
|
|||||||
encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> LByteString
|
encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> LByteString
|
||||||
encodeOpenAPI pds ti uri sd pks = encode $ postgrestSpec pds ti uri sd pks
|
encodeOpenAPI pds ti uri sd pks = encode $ postgrestSpec pds ti uri sd pks
|
||||||
|
|
||||||
{-|
|
|
||||||
Test whether a proxy uri is malformed or not.
|
|
||||||
A valid proxy uri should be an absolute uri without query and user info,
|
|
||||||
only http(s) schemes are valid, port number range is 1-65535.
|
|
||||||
|
|
||||||
For example
|
|
||||||
http://postgrest.com/openapi.json
|
|
||||||
https://postgrest.com:8080/openapi.json
|
|
||||||
-}
|
|
||||||
isMalformedProxyUri :: Maybe Text -> Bool
|
|
||||||
isMalformedProxyUri Nothing = False
|
|
||||||
isMalformedProxyUri (Just uri)
|
|
||||||
| isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri
|
|
||||||
| otherwise = True
|
|
||||||
|
|
||||||
toURI :: Text -> URI
|
|
||||||
toURI uri = fromJust $ parseURI (toS uri)
|
|
||||||
|
|
||||||
pickProxy :: Maybe Text -> Maybe Proxy
|
pickProxy :: Maybe Text -> Maybe Proxy
|
||||||
pickProxy proxy
|
pickProxy proxy
|
||||||
| isNothing proxy = Nothing
|
| isNothing proxy = Nothing
|
||||||
@@ -352,40 +335,3 @@ pickProxy proxy
|
|||||||
("", "http") -> 80
|
("", "http") -> 80
|
||||||
("", "https") -> 443
|
("", "https") -> 443
|
||||||
_ -> readPort $ unpack $ tail $ pack port'
|
_ -> readPort $ unpack $ tail $ pack port'
|
||||||
|
|
||||||
isUriValid:: URI -> Bool
|
|
||||||
isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
|
|
||||||
|
|
||||||
fAnd :: [a -> Bool] -> a -> Bool
|
|
||||||
fAnd fs x = all ($ x) fs
|
|
||||||
|
|
||||||
isSchemeValid :: URI -> Bool
|
|
||||||
isSchemeValid URI {uriScheme = s}
|
|
||||||
| toLower (pack s) == "https:" = True
|
|
||||||
| toLower (pack s) == "http:" = True
|
|
||||||
| otherwise = False
|
|
||||||
|
|
||||||
isQueryValid :: URI -> Bool
|
|
||||||
isQueryValid URI {uriQuery = ""} = True
|
|
||||||
isQueryValid _ = False
|
|
||||||
|
|
||||||
isAuthorityValid :: URI -> Bool
|
|
||||||
isAuthorityValid URI {uriAuthority = a}
|
|
||||||
| isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
|
|
||||||
| otherwise = False
|
|
||||||
|
|
||||||
isUserInfoValid :: URIAuth -> Bool
|
|
||||||
isUserInfoValid URIAuth {uriUserInfo = ""} = True
|
|
||||||
isUserInfoValid _ = False
|
|
||||||
|
|
||||||
isHostValid :: URIAuth -> Bool
|
|
||||||
isHostValid URIAuth {uriRegName = ""} = False
|
|
||||||
isHostValid _ = True
|
|
||||||
|
|
||||||
isPortValid :: URIAuth -> Bool
|
|
||||||
isPortValid URIAuth {uriPort = ""} = True
|
|
||||||
isPortValid URIAuth {uriPort = (':':p)} =
|
|
||||||
case readMaybe p of
|
|
||||||
Just i -> i > (0 :: Integer) && i < 65536
|
|
||||||
Nothing -> False
|
|
||||||
isPortValid _ = False
|
|
||||||
|
|||||||
@@ -0,0 +1,72 @@
|
|||||||
|
|
||||||
|
{-|
|
||||||
|
Module : PostgREST.Private.ProxyUri
|
||||||
|
Description : Proxy Uri validator
|
||||||
|
-}
|
||||||
|
module PostgREST.Private.ProxyUri (
|
||||||
|
isMalformedProxyUri
|
||||||
|
, toURI
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Data.Text (pack, toLower)
|
||||||
|
import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI)
|
||||||
|
|
||||||
|
import Protolude hiding (Proxy, dropWhile, get, intercalate,
|
||||||
|
toLower, toS, (&))
|
||||||
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
Test whether a proxy uri is malformed or not.
|
||||||
|
A valid proxy uri should be an absolute uri without query and user info,
|
||||||
|
only http(s) schemes are valid, port number range is 1-65535.
|
||||||
|
|
||||||
|
For example
|
||||||
|
http://postgrest.com/openapi.json
|
||||||
|
https://postgrest.com:8080/openapi.json
|
||||||
|
-}
|
||||||
|
isMalformedProxyUri :: Maybe Text -> Bool
|
||||||
|
isMalformedProxyUri Nothing = False
|
||||||
|
isMalformedProxyUri (Just uri)
|
||||||
|
| isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri
|
||||||
|
| otherwise = True
|
||||||
|
|
||||||
|
toURI :: Text -> URI
|
||||||
|
toURI uri = fromJust $ parseURI (toS uri)
|
||||||
|
|
||||||
|
isUriValid:: URI -> Bool
|
||||||
|
isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
|
||||||
|
|
||||||
|
fAnd :: [a -> Bool] -> a -> Bool
|
||||||
|
fAnd fs x = all ($ x) fs
|
||||||
|
|
||||||
|
isSchemeValid :: URI -> Bool
|
||||||
|
isSchemeValid URI {uriScheme = s}
|
||||||
|
| toLower (pack s) == "https:" = True
|
||||||
|
| toLower (pack s) == "http:" = True
|
||||||
|
| otherwise = False
|
||||||
|
|
||||||
|
isQueryValid :: URI -> Bool
|
||||||
|
isQueryValid URI {uriQuery = ""} = True
|
||||||
|
isQueryValid _ = False
|
||||||
|
|
||||||
|
isAuthorityValid :: URI -> Bool
|
||||||
|
isAuthorityValid URI {uriAuthority = a}
|
||||||
|
| isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
|
||||||
|
| otherwise = False
|
||||||
|
|
||||||
|
isUserInfoValid :: URIAuth -> Bool
|
||||||
|
isUserInfoValid URIAuth {uriUserInfo = ""} = True
|
||||||
|
isUserInfoValid _ = False
|
||||||
|
|
||||||
|
isHostValid :: URIAuth -> Bool
|
||||||
|
isHostValid URIAuth {uriRegName = ""} = False
|
||||||
|
isHostValid _ = True
|
||||||
|
|
||||||
|
isPortValid :: URIAuth -> Bool
|
||||||
|
isPortValid URIAuth {uriPort = ""} = True
|
||||||
|
isPortValid URIAuth {uriPort = (':':p)} =
|
||||||
|
case readMaybe p of
|
||||||
|
Just i -> i > (0 :: Integer) && i < 65536
|
||||||
|
Nothing -> False
|
||||||
|
isPortValid _ = False
|
||||||
@@ -535,3 +535,6 @@ data ConnectionStatus
|
|||||||
| Connected PgVersion
|
| Connected PgVersion
|
||||||
| FatalConnectionError Text
|
| FatalConnectionError Text
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Logging setup
|
||||||
|
data LogSetup = LogQuiet | LogStdout deriving (Eq, Show)
|
||||||
|
|||||||
+3
-3
@@ -15,7 +15,7 @@ import Test.Hspec
|
|||||||
import PostgREST.App (postgrest)
|
import PostgREST.App (postgrest)
|
||||||
import PostgREST.Config (AppConfig (..))
|
import PostgREST.Config (AppConfig (..))
|
||||||
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
||||||
import PostgREST.Types (pgVersion95, pgVersion96)
|
import PostgREST.Types (LogSetup (..), pgVersion95, pgVersion96)
|
||||||
import Protolude hiding (toList, toS)
|
import Protolude hiding (toList, toS)
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
import SpecHelper
|
import SpecHelper
|
||||||
@@ -65,12 +65,12 @@ main = do
|
|||||||
|
|
||||||
let
|
let
|
||||||
-- For tests that run with the same refDbStructure
|
-- For tests that run with the same refDbStructure
|
||||||
app cfg = return ((), postgrest (cfg testDbConn) refDbStructure pool getTime $ pure ())
|
app cfg = return ((), postgrest LogQuiet (cfg testDbConn) refDbStructure pool getTime $ pure ())
|
||||||
|
|
||||||
-- For tests that run with a different DbStructure(depends on configSchemas)
|
-- For tests that run with a different DbStructure(depends on configSchemas)
|
||||||
appDbs cfg = do
|
appDbs cfg = do
|
||||||
dbs <- (newIORef . Just) =<< setupDbStructure pool (configSchemas $ cfg testDbConn) actualPgVersion
|
dbs <- (newIORef . Just) =<< setupDbStructure pool (configSchemas $ cfg testDbConn) actualPgVersion
|
||||||
return ((), postgrest (cfg testDbConn) dbs pool getTime $ pure ())
|
return ((), postgrest LogQuiet (cfg testDbConn) dbs pool getTime $ pure ())
|
||||||
|
|
||||||
let withApp = app testCfg
|
let withApp = app testCfg
|
||||||
maxRowsApp = app testMaxRowsCfg
|
maxRowsApp = app testMaxRowsCfg
|
||||||
|
|||||||
+27
-31
@@ -64,36 +64,32 @@ getEnvVarWithDefault var def = toS <$>
|
|||||||
getEnv (toS var) `E.catchIOError` const (return $ toS def)
|
getEnv (toS var) `E.catchIOError` const (return $ toS def)
|
||||||
|
|
||||||
_baseCfg :: AppConfig
|
_baseCfg :: AppConfig
|
||||||
_baseCfg = -- Connection Settings
|
_baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
|
||||||
let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
|
AppConfig {
|
||||||
AppConfig mempty "postgrest_test_anonymous" Nothing (fromList ["test"]) "localhost" 3000
|
configDbUri = mempty
|
||||||
-- No user configured Unix Socket
|
, configAnonRole = "postgrest_test_anonymous"
|
||||||
Nothing
|
, configOpenAPIProxyUri = Nothing
|
||||||
-- No user configured Unix Socket file mode (defaults to 660)
|
, configSchemas = fromList ["test"]
|
||||||
(Right 432)
|
, configHost = "localhost"
|
||||||
-- db-channel
|
, configPort = 3000
|
||||||
"pgrst"
|
, configSocket = Nothing
|
||||||
-- db-channel-enabled
|
, configSocketMode = Right 432
|
||||||
False
|
, configDbChannel = mempty
|
||||||
-- Jwt settings
|
, configDbChannelEnabled = False
|
||||||
secret False Nothing
|
, configJwtSecret = secret
|
||||||
-- Connection Modifiers
|
, configJwtSecretIsBase64 = False
|
||||||
10 10 Nothing (Just "test.switch_role")
|
, configJwtAudience = Nothing
|
||||||
-- Debug Settings
|
, configPoolSize = 10
|
||||||
True
|
, configPoolTimeout = 10
|
||||||
[ ("app.settings.app_host", "localhost")
|
, configMaxRows = Nothing
|
||||||
, ("app.settings.external_api_secret", "0123456789abcdef")
|
, configPreReq = Just "test.switch_role"
|
||||||
]
|
, configSettings = [ ("app.settings.app_host", "localhost") , ("app.settings.external_api_secret", "0123456789abcdef") ]
|
||||||
-- Default role claim key
|
, configRoleClaimKey = Right [JSPKey "role"]
|
||||||
(Right [JSPKey "role"])
|
, configExtraSearchPath = []
|
||||||
-- Empty db-extra-search-path
|
, configRootSpec = Nothing
|
||||||
[]
|
, configRawMediaTypes = []
|
||||||
-- No root spec override
|
, configJWKS = parseSecret <$> secret
|
||||||
Nothing
|
}
|
||||||
-- Raw output media types
|
|
||||||
[]
|
|
||||||
-- Config JWK
|
|
||||||
(parseSecret <$> secret)
|
|
||||||
|
|
||||||
testCfg :: Text -> AppConfig
|
testCfg :: Text -> AppConfig
|
||||||
testCfg testDbConn = _baseCfg { configDbUri = testDbConn }
|
testCfg testDbConn = _baseCfg { configDbUri = testDbConn }
|
||||||
@@ -156,7 +152,7 @@ testCfgHtmlRawOutput :: Text -> AppConfig
|
|||||||
testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }
|
testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }
|
||||||
|
|
||||||
testCfgResponseHeaders :: Text -> AppConfig
|
testCfgResponseHeaders :: Text -> AppConfig
|
||||||
testCfgResponseHeaders testDbConn = (testCfg testDbConn) { configReqCheck = Just "custom_headers" }
|
testCfgResponseHeaders testDbConn = (testCfg testDbConn) { configPreReq = Just "custom_headers" }
|
||||||
|
|
||||||
testMultipleSchemaCfg :: Text -> AppConfig
|
testMultipleSchemaCfg :: Text -> AppConfig
|
||||||
testMultipleSchemaCfg testDbConn = (testCfg testDbConn) { configSchemas = fromList ["v1", "v2"] }
|
testMultipleSchemaCfg testDbConn = (testCfg testDbConn) { configSchemas = fromList ["v1", "v2"] }
|
||||||
|
|||||||
Reference in New Issue
Block a user