test: Separated query and loading internal sleep configs

To make schema cache loading wait tests robust it is necessary to provide three separate internal config variables:
* "internal-schema-cache-query-sleep" - introduces delay in schema queries execution
* "internal-schema-cache-load-sleep" - introduces delay between schema queries execution and processing their results
* "internal-schema-cache-relationship-load-sleep" - introduces delay in processing relationship query results

Thanks to these changes it is now possible to test various schema loading scenarios with the right granularity robustly (eg. make sure requests wait for schema loading but not for relationship loading).

src/PostgREST/Config.hs

@@ -115,7 +115,9 @@ data AppConfig = AppConfig
   , configAdminServerPort          :: Maybe Int
   , configRoleSettings             :: RoleSettings
   , configRoleIsoLvl               :: RoleIsolationLvl
-  , configInternalSCSleep          :: Maybe Int32
+  , configInternalSCQuerySleep     :: Maybe Int32
+  , configInternalSCLoadSleep      :: Maybe Int32
+  , configInternalSCRelLoadSleep   :: Maybe Int32
   }
 
 data LogLevel = LogCrit | LogError | LogWarn | LogInfo | LogDebug
@@ -298,7 +300,9 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> parseAdminServerPort "admin-server-port"
     <*> pure roleSettings
     <*> pure roleIsolationLvl
-    <*> optInt "internal-schema-cache-sleep"
+    <*> optInt "internal-schema-cache-query-sleep"
+    <*> optInt "internal-schema-cache-load-sleep"
+    <*> optInt "internal-schema-cache-relationship-load-sleep"
   where
     parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
     parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value

src/PostgREST/SchemaCache.hs

@@ -25,8 +25,6 @@ module PostgREST.SchemaCache
   , decodeFuncs
   ) where
 
-import Control.Monad.Extra (whenJust)
-
 import           Data.Aeson                 ((.=))
 import qualified Data.Aeson                 as JSON
 import qualified Data.HashMap.Strict        as HM
@@ -69,6 +67,7 @@ import PostgREST.SchemaCache.Table           (Column (..), ColumnMap,
 import qualified PostgREST.MediaType as MediaType
 
 import Protolude
+import System.IO.Unsafe (unsafePerformIO)
 
 data SchemaCache = SchemaCache
   { dbTables          :: TablesMap
@@ -152,14 +151,16 @@ querySchemaCache conf@AppConfig{..} = do
   tzones  <- SQL.statement mempty $ timezones prepared
   _       <-
     let sleepCall = SQL.Statement "select pg_sleep($1 / 1000.0)" (param HE.int4) HD.noResult prepared in
-    whenJust configInternalSCSleep (`SQL.statement` sleepCall) -- only used for testing
+    for_ configInternalSCQuerySleep (`SQL.statement` sleepCall) -- only used for testing
 
   let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
       rels          = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
 
-  return $ removeInternal schemas $ SchemaCache {
+  -- Add delay in loading schema cache when internal-schema-cache-load-sleep config is set
+  return $ delayEval configInternalSCLoadSleep $ removeInternal schemas $ SchemaCache {
       dbTables = tabsWViewsPks
-    , dbRelationships = getOverrideRelationshipsMap rels cRels
+    -- Add delay in loading relationships when internal-schema-cache-relationship-load-sleep config is set
+    , dbRelationships = delayEval configInternalSCRelLoadSleep $ getOverrideRelationshipsMap rels cRels
     , dbRoutines = funcs
     , dbRepresentations = reps
     , dbMediaHandlers = HM.union mHdlers initialMediaHandlers -- the custom handlers will override the initial ones
@@ -168,6 +169,7 @@ querySchemaCache conf@AppConfig{..} = do
   where
     schemas = toList configDbSchemas
     prepared = configDbPreparedStatements
+    delayEval confDelay result = maybe result (unsafePerformIO . (($> result) . (threadDelay . (1000 *) . fromIntegral))) confDelay
 
 -- | overrides detected relationships with the computed relationships and gets the RelationshipsMap
 getOverrideRelationshipsMap :: [Relationship] -> [Relationship] -> RelationshipsMap