Michał KłeczekandSteve Chavez
8fa26ee865
This change ensures PostgREST starts listening on a server socket only after it loaded the schema cache and is ready to handle requests. It is no longer going to return 503 errors during startup until the schema cache is loaded.
248 lines
9.8 KiB
Haskell
248 lines
9.8 KiB
Haskell
module SpecHelper where
|
|
|
|
import Control.Lens ((^?))
|
|
import qualified Data.Aeson as JSON
|
|
import Data.Aeson.Lens
|
|
import qualified Data.ByteString.Base64 as B64 (decodeLenient)
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Scientific (toRealFloat)
|
|
import qualified Data.Set as S
|
|
import qualified Jose.Jwa as JWT
|
|
import qualified Jose.Jws as JWT
|
|
import qualified Jose.Jwt as JWT
|
|
|
|
import Data.Aeson ((.=))
|
|
import Data.CaseInsensitive (CI (..), original)
|
|
import Data.List (lookup)
|
|
import Data.List.NonEmpty (fromList)
|
|
import Network.Wai (Application)
|
|
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders, simpleStatus))
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
import Text.Regex.TDFA ((=~))
|
|
|
|
|
|
import Network.HTTP.Types
|
|
import Test.Hspec
|
|
import Test.Hspec.Wai
|
|
|
|
import Data.String (String)
|
|
import PostgREST.Config (AppConfig (..),
|
|
JSPathExp (..),
|
|
LogLevel (..),
|
|
OpenAPIMode (..),
|
|
Verbosity (..), parseSecret)
|
|
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
|
|
import Protolude hiding (get, toS)
|
|
import Protolude.Conv (toS)
|
|
|
|
filterAndMatchCT :: BS.ByteString -> MatchHeader
|
|
filterAndMatchCT val = MatchHeader $ \headers _ ->
|
|
case filter (\(n,_) -> n == hContentType) headers of
|
|
[(_,v)] -> if v == val
|
|
then Nothing
|
|
else Just $ "missing value:" <> toS val <> "\n"
|
|
_ -> Just "unexpected header: zero or multiple headers present\n"
|
|
|
|
matchContentTypeJson :: MatchHeader
|
|
matchContentTypeJson =
|
|
filterAndMatchCT "application/json; charset=utf-8"
|
|
|
|
matchContentTypeSingular :: MatchHeader
|
|
matchContentTypeSingular =
|
|
filterAndMatchCT "application/vnd.pgrst.object+json; charset=utf-8"
|
|
|
|
matchCTArrayStrip :: MatchHeader
|
|
matchCTArrayStrip =
|
|
filterAndMatchCT "application/vnd.pgrst.array+json;nulls=stripped; charset=utf-8"
|
|
|
|
matchCTSingularStrip :: MatchHeader
|
|
matchCTSingularStrip =
|
|
filterAndMatchCT "application/vnd.pgrst.object+json;nulls=stripped; charset=utf-8"
|
|
|
|
matchHeaderValuePresent :: HeaderName -> BS.ByteString -> MatchHeader
|
|
matchHeaderValuePresent name val = MatchHeader $ \headers _ ->
|
|
case lookup name headers of
|
|
Just hdr -> if val `BS.isInfixOf` hdr then Nothing else Just $ "missing header value: " <> toS val <> "\n"
|
|
Nothing -> Just $ "missing header: " <> toS (original name) <> "\n"
|
|
|
|
matchHeaderAbsent :: HeaderName -> MatchHeader
|
|
matchHeaderAbsent name = MatchHeader $ \headers _body ->
|
|
case lookup name headers of
|
|
Just _ -> Just $ "unexpected header: " <> toS (original name) <> "\n"
|
|
Nothing -> Nothing
|
|
|
|
-- | Matches Server-Timing header has a well-formed metric with the given name
|
|
matchServerTimingHasTiming :: String -> MatchHeader
|
|
matchServerTimingHasTiming metric = MatchHeader $ \headers _body ->
|
|
case lookup "Server-Timing" headers of
|
|
Just hdr -> if hdr =~ (metric <> ";dur=[[:digit:]]+.[[:digit:]]+")
|
|
then Nothing
|
|
else Just $ "missing metric: " <> metric <> "\n"
|
|
Nothing -> Just "missing Server-Timing header\n"
|
|
|
|
validateOpenApiResponse :: [Header] -> WaiSession () ()
|
|
validateOpenApiResponse headers = do
|
|
r <- request methodGet "/" headers ""
|
|
liftIO $
|
|
let respStatus = simpleStatus r in
|
|
respStatus `shouldSatisfy`
|
|
\s -> s == Status { statusCode = 200, statusMessage="OK" }
|
|
liftIO $
|
|
let respHeaders = simpleHeaders r in
|
|
respHeaders `shouldSatisfy`
|
|
\hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
|
|
Just body <- pure $ JSON.decode (simpleBody r)
|
|
Just schema <- liftIO $ JSON.decode <$> BL.readFile "test/spec/fixtures/openapi.json"
|
|
let args :: M.Map Text JSON.Value
|
|
args = M.fromList
|
|
[ ( "schema", schema )
|
|
, ( "data", body ) ]
|
|
hdrs = acceptHdrs "application/json"
|
|
request methodPost "/rpc/validate_json_schema" hdrs (JSON.encode args)
|
|
`shouldRespondWith` "true"
|
|
{ matchStatus = 200
|
|
, matchHeaders = []
|
|
}
|
|
|
|
type SpecWithConfig = (AppConfig -> SpecWith ((), Application) -> Spec) -> Spec
|
|
|
|
baseCfg :: AppConfig
|
|
baseCfg = let secret = encodeUtf8 "reallyreallyreallyreallyverysafe" in
|
|
AppConfig {
|
|
configAppSettings = [ ("app.settings.app_host", "localhost") , ("app.settings.external_api_secret", "0123456789abcdef") ]
|
|
, configClientErrorVerbosity = Verbose
|
|
, configDbAggregates = False
|
|
, configDbAnonRole = Just "postgrest_test_anonymous"
|
|
, configDbChannel = mempty
|
|
, configDbChannelEnabled = True
|
|
, configDbExtraSearchPath = []
|
|
, configDbHoistedTxSettings = ["default_transaction_isolation","plan_filter.statement_cost_limit","statement_timeout"]
|
|
, configDbMaxRows = Nothing
|
|
, configDbPlanEnabled = False
|
|
, configDbPoolSize = 10
|
|
, configDbPoolAcquisitionTimeout = 10
|
|
, configDbPoolMaxLifetime = 1800
|
|
, configDbPoolMaxIdletime = 600
|
|
, configDbPoolAutomaticRecovery = True
|
|
, configDbPreRequest = Just $ QualifiedIdentifier "test" "switch_role"
|
|
, configDbPreparedStatements = True
|
|
, configDbRootSpec = Nothing
|
|
, configDbSchemas = fromList ["test"]
|
|
, configDbConfig = False
|
|
, configDbPreConfig = Nothing
|
|
, configDbTimezoneEnabled = True
|
|
, configDbUri = "postgresql://"
|
|
, configFilePath = Nothing
|
|
, configJWKS = rightToMaybe $ parseSecret secret
|
|
, configJwtAudience = Nothing
|
|
, configJwtRoleClaimKey = [JSPKey "role"]
|
|
, configJwtSecret = Just secret
|
|
, configJwtSecretIsBase64 = False
|
|
, configJwtCacheMaxEntries = 10
|
|
, configLogLevel = LogCrit
|
|
, configLogQuery = False
|
|
, configOpenApiMode = OAFollowPriv
|
|
, configOpenApiSecurityActive = False
|
|
, configOpenApiServerProxyUri = Nothing
|
|
, configServerCorsAllowedOrigins = []
|
|
, configServerHost = "localhost"
|
|
, configServerPort = 3000
|
|
, configServerTraceHeader = Nothing
|
|
, configServerUnixSocket = Nothing
|
|
, configServerUnixSocketMode = 432
|
|
, configDbTxAllowOverride = True
|
|
, configDbTxRollbackAll = True
|
|
, configAdminServerHost = "localhost"
|
|
, configAdminServerPort = Nothing
|
|
, configAdminServerUnixSocket = Nothing
|
|
, configAdminServerUnixSocketMode = 432
|
|
, configRoleSettings = mempty
|
|
, configRoleIsoLvl = mempty
|
|
, configInternalSCQuerySleepFst = Nothing
|
|
, configInternalSCQuerySleepSnd = Nothing
|
|
, configServerTimingEnabled = True
|
|
}
|
|
|
|
rangeHdrs :: ByteRange -> [Header]
|
|
rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
|
|
|
|
rangeHdrsWithCount :: ByteRange -> [Header]
|
|
rangeHdrsWithCount r = ("Prefer", "count=exact") : rangeHdrs r
|
|
|
|
acceptHdrs :: BS.ByteString -> [Header]
|
|
acceptHdrs mime = [(hAccept, mime)]
|
|
|
|
planHdr :: Header
|
|
planHdr = (hAccept, "application/vnd.pgrst.plan+json")
|
|
|
|
rangeUnit :: Header
|
|
rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")
|
|
|
|
matchHeader :: CI BS.ByteString -> BS.ByteString -> [Header] -> Bool
|
|
matchHeader name valRegex headers =
|
|
maybe False (=~ valRegex) $ lookup name headers
|
|
|
|
noBlankHeader :: [Header] -> Bool
|
|
noBlankHeader = notElem mempty
|
|
|
|
noProfileHeader :: [Header] -> Bool
|
|
noProfileHeader headers = isNothing $ find ((== "Content-Profile") . fst) headers
|
|
|
|
notZeroContentLength :: [Header] -> Bool
|
|
notZeroContentLength headers = maybe False (/= "0") $ lookup hContentLength headers
|
|
|
|
authHeader :: BS.ByteString -> BS.ByteString -> Header
|
|
authHeader typ creds =
|
|
(hAuthorization, typ <> " " <> creds)
|
|
|
|
authHeaderJWT :: BS.ByteString -> Header
|
|
authHeaderJWT = authHeader "Bearer"
|
|
|
|
generateSecret :: ByteString
|
|
generateSecret = B64.decodeLenient "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU="
|
|
|
|
generateJWT :: BL.ByteString -> ByteString
|
|
generateJWT claims =
|
|
either mempty JWT.unJwt $ JWT.hmacEncode JWT.HS256 generateSecret (BL.toStrict claims)
|
|
|
|
-- | Tests whether the text can be parsed as a json object containing
|
|
-- the key "message", and optional keys "details", "hint", "code",
|
|
-- and no extraneous keys
|
|
isErrorFormat :: BL.ByteString -> Bool
|
|
isErrorFormat s =
|
|
"message" `S.member` keys &&
|
|
S.null (S.difference keys validKeys)
|
|
where
|
|
obj = JSON.decode s :: Maybe (M.Map Text JSON.Value)
|
|
keys = maybe S.empty M.keysSet obj
|
|
validKeys = S.fromList ["message", "details", "hint", "code"]
|
|
|
|
planCost :: SResponse -> Float
|
|
planCost resp =
|
|
let res = simpleBody resp ^? nth 0 . key "Plan" . key "Total Cost" in
|
|
-- big value in case parsing fails
|
|
fromMaybe 1000000000.0 $ unbox =<< res
|
|
where
|
|
unbox :: JSON.Value -> Maybe Float
|
|
unbox (JSON.Number n) = Just $ toRealFloat n
|
|
unbox _ = Nothing
|
|
|
|
data TiobePlsRow = TiobePlsRow {
|
|
name' :: Text,
|
|
rank :: Int
|
|
} deriving (Show)
|
|
|
|
instance JSON.ToJSON TiobePlsRow where
|
|
toJSON (TiobePlsRow name'' rank') = JSON.object ["name" .= name'', "rank" .= rank']
|
|
|
|
getInsertDataForTiobePlsTable :: Int -> BL.ByteString
|
|
getInsertDataForTiobePlsTable rows =
|
|
JSON.encode $ fromList $ [TiobePlsRow {name' = nm, rank = rk} | (nm,rk) <- nameRankList]
|
|
where
|
|
nameRankList = [("Lang " <> show i, i) | i <- [20..(rows+20)] ] :: [(Text, Int)]
|
|
|
|
readFixtureFile :: FilePath -> BL.ByteString
|
|
readFixtureFile file = unsafePerformIO $ BL.readFile $ "test/spec/fixtures/" <> file
|