hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-14 08:02:15 +03:00
Code Issues Projects Releases Wiki Activity

Replace Hasura.RQL.Types.Numeric with refined

Browse Source 
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5913
GitOrigin-RevId: 96e218229a08dfbc5a598d709be1ee2083d41ec6
This commit is contained in:
Tom Harding 2022-09-21 20:01:48 +02:00 committed by hasura-bot
parent 1c7e19c209
commit e71496efa5
24 changed files with 213 additions and 412 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cabal.project.freeze
View File

@ -241,6 +241,7 @@ constraints: any.Cabal ==3.2.1.0,
any.quickcheck-instances ==0.3.27, any.quickcheck-instances ==0.3.27,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1, any.random ==1.2.1,
any.refined ==0.7,
any.reflection ==2.1.6, any.reflection ==2.1.6,
any.regex-base ==0.94.0.2, any.regex-base ==0.94.0.2,
any.regex-tdfa ==1.3.1.1, any.regex-tdfa ==1.3.1.1,
@ -302,6 +303,7 @@ constraints: any.Cabal ==3.2.1.0,
any.th-orphans ==0.13.12, any.th-orphans ==0.13.12,
any.th-reify-many ==0.1.10, any.th-reify-many ==0.1.10,
any.these ==1.1.1.1, any.these ==1.1.1.1,
any.these-skinny ==0.7.5,
any.time ==1.9.3, any.time ==1.9.3,
any.time-compat ==1.9.6.1, any.time-compat ==1.9.6.1,
any.time-locale-compat ==0.1.1.5, any.time-locale-compat ==0.1.1.5,

4
server/graphql-engine.cabal
View File

@ -186,6 +186,7 @@ common lib-depends
, pretty-simple , pretty-simple
, process , process
, profunctors , profunctors
, refined
, retry , retry
, safe-exceptions , safe-exceptions
, scientific , scientific
@ -683,7 +684,6 @@ library
, Hasura.RQL.Types.Metadata.Object , Hasura.RQL.Types.Metadata.Object
, Hasura.RQL.Types.Metadata.Serialization , Hasura.RQL.Types.Metadata.Serialization
, Hasura.RQL.Types.Network , Hasura.RQL.Types.Network
, Hasura.RQL.Types.Numeric
, Hasura.RQL.Types.Permission , Hasura.RQL.Types.Permission
, Hasura.RQL.Types.QueryCollection , Hasura.RQL.Types.QueryCollection
, Hasura.RQL.Types.QueryTags , Hasura.RQL.Types.QueryTags
@ -900,6 +900,7 @@ executable graphql-engine
, hasura-prelude , hasura-prelude
, kan-extensions , kan-extensions
, pg-client , pg-client
, refined
, text , text
, text-conversions , text-conversions
, time , time
@ -1010,7 +1011,6 @@ test-suite graphql-engine-tests
Control.Monad.MemoizeSpec Control.Monad.MemoizeSpec
Control.Monad.TimeLimit Control.Monad.TimeLimit
Data.HashMap.Strict.ExtendedSpec Data.HashMap.Strict.ExtendedSpec
Data.NumericSpec
Data.Parser.CacheControlSpec Data.Parser.CacheControlSpec
Data.Parser.JSONPathSpec Data.Parser.JSONPathSpec
Data.Parser.RemoteRelationshipSpec Data.Parser.RemoteRelationshipSpec

16
server/src-lib/Hasura/App.hs
View File

@ -110,7 +110,6 @@ import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Eventing.Backend import Hasura.RQL.Types.Eventing.Backend
import Hasura.RQL.Types.Metadata import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Network import Hasura.RQL.Types.Network
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source import Hasura.RQL.Types.Source
@ -148,6 +147,7 @@ import Network.HTTP.Client.Transformable qualified as HTTP
import Network.Wai (Application) import Network.Wai (Application)
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import Options.Applicative import Options.Applicative
import Refined (unrefine)
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
import System.Log.FastLogger qualified as FL import System.Log.FastLogger qualified as FL
import System.Metrics qualified as EKG import System.Metrics qualified as EKG
@ -915,11 +915,11 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
waitForProcessingAction l actionType processingEventsCountAction' shutdownAction (maxTimeout - (Seconds 5)) waitForProcessingAction l actionType processingEventsCountAction' shutdownAction (maxTimeout - (Seconds 5))
startEventTriggerPollerThread logger lockedEventsCtx cacheRef = do startEventTriggerPollerThread logger lockedEventsCtx cacheRef = do
let maxEventThreads = Numeric.getPositiveInt soEventsHttpPoolSize let maxEventThreads = unrefine soEventsHttpPoolSize
fetchInterval = milliseconds $ Numeric.getNonNegative soEventsFetchInterval fetchInterval = milliseconds $ unrefine soEventsFetchInterval
allSources = HM.elems $ scSources $ lastBuiltSchemaCache _scSchemaCache allSources = HM.elems $ scSources $ lastBuiltSchemaCache _scSchemaCache
unless (Numeric.getNonNegativeInt soEventsFetchBatchSize == 0 || fetchInterval == 0) $ do unless (unrefine soEventsFetchBatchSize == 0 || fetchInterval == 0) $ do
-- Don't start the events poller thread when fetchBatchSize or fetchInterval is 0 -- Don't start the events poller thread when fetchBatchSize or fetchInterval is 0
-- prepare event triggers data -- prepare event triggers data
eventEngineCtx <- liftIO $ atomically $ initEventEngineCtx maxEventThreads fetchInterval soEventsFetchBatchSize eventEngineCtx <- liftIO $ atomically $ initEventEngineCtx maxEventThreads fetchInterval soEventsFetchBatchSize
@ -929,7 +929,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
"event_triggers" "event_triggers"
(length <$> readTVarIO (leEvents lockedEventsCtx)) (length <$> readTVarIO (leEvents lockedEventsCtx))
(EventTriggerShutdownAction (shutdownEventTriggerEvents allSources logger lockedEventsCtx)) (EventTriggerShutdownAction (shutdownEventTriggerEvents allSources logger lockedEventsCtx))
(Numeric.getNonNegative soGracefulShutdownTimeout) (unrefine soGracefulShutdownTimeout)
unLogger logger $ mkGenericStrLog LevelInfo "event_triggers" "starting workers" unLogger logger $ mkGenericStrLog LevelInfo "event_triggers" "starting workers"
void $ void $
C.forkManagedTWithGracefulShutdown C.forkManagedTWithGracefulShutdown
@ -950,7 +950,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
-- start a background thread to handle async actions -- start a background thread to handle async actions
case soAsyncActionsFetchInterval of case soAsyncActionsFetchInterval of
Skip -> pure () -- Don't start the poller thread Skip -> pure () -- Don't start the poller thread
Interval (Numeric.getNonNegative -> sleepTime) -> do Interval (unrefine -> sleepTime) -> do
let label = "asyncActionsProcessor" let label = "asyncActionsProcessor"
asyncActionGracefulShutdownAction = asyncActionGracefulShutdownAction =
( liftWithStateless \lowerIO -> ( liftWithStateless \lowerIO ->
@ -959,7 +959,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
"async_actions" "async_actions"
(length <$> readTVarIO (leActionEvents lockedEventsCtx)) (length <$> readTVarIO (leActionEvents lockedEventsCtx))
(MetadataDBShutdownAction (hoist lowerIO (shutdownAsyncActions lockedEventsCtx))) (MetadataDBShutdownAction (hoist lowerIO (shutdownAsyncActions lockedEventsCtx)))
(Numeric.getNonNegative soGracefulShutdownTimeout) (unrefine soGracefulShutdownTimeout)
) )
) )
@ -995,7 +995,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
"scheduled_events" "scheduled_events"
(getProcessingScheduledEventsCount lockedEventsCtx) (getProcessingScheduledEventsCount lockedEventsCtx)
(MetadataDBShutdownAction (hoist lowerIO unlockAllLockedScheduledEvents)) (MetadataDBShutdownAction (hoist lowerIO unlockAllLockedScheduledEvents))
(Numeric.getNonNegative soGracefulShutdownTimeout) (unrefine soGracefulShutdownTimeout)
) )
) )

14
server/src-lib/Hasura/Base/Instances.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
-- | This module defines all missing instances of third party libraries. -- | This module defines all missing instances of third party libraries.
@ -6,13 +7,16 @@ module Hasura.Base.Instances () where
import Control.Monad.Fix import Control.Monad.Fix
import Data.Aeson qualified as J import Data.Aeson qualified as J
import Data.Fixed (Fixed (..))
import Data.Functor.Product (Product (Pair)) import Data.Functor.Product (Product (Pair))
import "some" Data.GADT.Compare (GCompare (gcompare), GOrdering (GEQ, GGT, GLT)) import "some" Data.GADT.Compare (GCompare (gcompare), GOrdering (GEQ, GGT, GLT))
import Data.OpenApi.Declare as D import Data.OpenApi.Declare as D
import Data.Text qualified as T import Data.Text qualified as T
import Data.Time (NominalDiffTime)
import Data.URL.Template qualified as UT import Data.URL.Template qualified as UT
import Database.PG.Query qualified as PG import Database.PG.Query qualified as PG
import Hasura.Prelude import Hasura.Prelude
import Language.Haskell.TH.Lift qualified as TH (deriveLift)
import Language.Haskell.TH.Syntax qualified as TH import Language.Haskell.TH.Syntax qualified as TH
import System.Cron.Parser qualified as C import System.Cron.Parser qualified as C
import System.Cron.Types qualified as C import System.Cron.Types qualified as C
@ -70,12 +74,22 @@ deriving instance TH.Lift TDFA.Pattern
deriving instance TH.Lift TDFA.PatternSet deriving instance TH.Lift TDFA.PatternSet
deriving instance TH.Lift (Fixed a)
deriving instance TH.Lift TDFA.PatternSetCharacterClass deriving instance TH.Lift TDFA.PatternSetCharacterClass
deriving instance TH.Lift TDFA.PatternSetCollatingElement deriving instance TH.Lift TDFA.PatternSetCollatingElement
deriving instance TH.Lift TDFA.PatternSetEquivalenceClass deriving instance TH.Lift TDFA.PatternSetEquivalenceClass
$(TH.deriveLift ''DiffTime)
$(TH.deriveLift ''NominalDiffTime)
deriving instance TH.Lift Milliseconds
deriving instance TH.Lift Seconds
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- GADT -- GADT

13
server/src-lib/Hasura/Eventing/EventTrigger.hs
View File

@ -74,8 +74,6 @@ import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common import Hasura.RQL.Types.Common
import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Eventing.Backend import Hasura.RQL.Types.Eventing.Backend
import Hasura.RQL.Types.Numeric (NonNegativeInt)
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source import Hasura.RQL.Types.Source
import Hasura.SQL.AnyBackend qualified as AB import Hasura.SQL.AnyBackend qualified as AB
@ -85,6 +83,7 @@ import Hasura.Server.Prometheus (EventTriggerMetrics (..))
import Hasura.Server.Types import Hasura.Server.Types
import Hasura.Tracing qualified as Tracing import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client.Transformable qualified as HTTP import Network.HTTP.Client.Transformable qualified as HTTP
import Refined (NonNegative, Positive, Refined, refineTH, unrefine)
import System.Metrics.Distribution qualified as EKG.Distribution import System.Metrics.Distribution qualified as EKG.Distribution
import System.Metrics.Gauge qualified as EKG.Gauge import System.Metrics.Gauge qualified as EKG.Gauge
import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge
@ -128,7 +127,7 @@ following way now:
data EventEngineCtx = EventEngineCtx data EventEngineCtx = EventEngineCtx
{ _eeCtxEventThreadsCapacity :: TVar Int, { _eeCtxEventThreadsCapacity :: TVar Int,
_eeCtxFetchInterval :: DiffTime, _eeCtxFetchInterval :: DiffTime,
_eeCtxFetchSize :: NonNegativeInt _eeCtxFetchSize :: Refined NonNegative Int
} }
data DeliveryInfo = DeliveryInfo data DeliveryInfo = DeliveryInfo
@ -168,13 +167,13 @@ deriving instance Backend b => Eq (EventPayload b)
instance Backend b => J.ToJSON (EventPayload b) where instance Backend b => J.ToJSON (EventPayload b) where
toJSON = J.genericToJSON hasuraJSON {omitNothingFields = True} toJSON = J.genericToJSON hasuraJSON {omitNothingFields = True}
defaultMaxEventThreads :: Numeric.PositiveInt defaultMaxEventThreads :: Refined Positive Int
defaultMaxEventThreads = Numeric.unsafePositiveInt 100 defaultMaxEventThreads = $$(refineTH 100)
defaultFetchInterval :: DiffTime defaultFetchInterval :: DiffTime
defaultFetchInterval = seconds 1 defaultFetchInterval = seconds 1
initEventEngineCtx :: Int -> DiffTime -> NonNegativeInt -> STM EventEngineCtx initEventEngineCtx :: Int -> DiffTime -> Refined NonNegative Int -> STM EventEngineCtx
initEventEngineCtx maxT _eeCtxFetchInterval _eeCtxFetchSize = do initEventEngineCtx maxT _eeCtxFetchInterval _eeCtxFetchSize = do
_eeCtxEventThreadsCapacity <- newTVar maxT _eeCtxEventThreadsCapacity <- newTVar maxT
return $ EventEngineCtx {..} return $ EventEngineCtx {..}
@ -230,7 +229,7 @@ processEventQueue logger httpMgr getSchemaCache EventEngineCtx {..} LockedEvents
events0 <- popEventsBatch events0 <- popEventsBatch
return $ Forever (events0, 0, False) go return $ Forever (events0, 0, False) go
where where
fetchBatchSize = Numeric.getNonNegativeInt _eeCtxFetchSize fetchBatchSize = unrefine _eeCtxFetchSize
popEventsBatch :: m [BackendEventWithSource] popEventsBatch :: m [BackendEventWithSource]
popEventsBatch = do popEventsBatch = do

13
server/src-lib/Hasura/Eventing/ScheduledTrigger.hs
View File

@ -144,12 +144,12 @@ import Hasura.RQL.DDL.Webhook.Transform
import Hasura.RQL.Types.Common import Hasura.RQL.Types.Common
import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Eventing import Hasura.RQL.Types.Eventing
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.ScheduledTrigger import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types import Hasura.SQL.Types
import Hasura.Tracing qualified as Tracing import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client.Transformable qualified as HTTP import Network.HTTP.Client.Transformable qualified as HTTP
import Refined (unrefine)
import Text.Builder qualified as TB import Text.Builder qualified as TB
-- | runCronEventsGenerator makes sure that all the cron triggers -- | runCronEventsGenerator makes sure that all the cron triggers
@ -358,13 +358,10 @@ processScheduledEvent eventId eventHeaders retryCtx payload webhookUrl type' =
let retryConf = _rctxConf retryCtx let retryConf = _rctxConf retryCtx
scheduledTime = sewpScheduledTime payload scheduledTime = sewpScheduledTime payload
if convertDuration (diffUTCTime currentTime scheduledTime) if convertDuration (diffUTCTime currentTime scheduledTime)
> Numeric.unNonNegativeDiffTime (strcToleranceSeconds retryConf) > unrefine (strcToleranceSeconds retryConf)
then processDead eventId type' then processDead eventId type'
else do else do
let timeoutSeconds = let timeoutSeconds = round $ unrefine (strcTimeoutSeconds retryConf)
round $
Numeric.unNonNegativeDiffTime $
strcTimeoutSeconds retryConf
httpTimeout = HTTP.responseTimeoutMicro (timeoutSeconds * 1000000) httpTimeout = HTTP.responseTimeoutMicro (timeoutSeconds * 1000000)
(headers, decodedHeaders) = prepareHeaders eventHeaders (headers, decodedHeaders) = prepareHeaders eventHeaders
extraLogCtx = ExtraLogContext eventId (sewpName payload) extraLogCtx = ExtraLogContext eventId (sewpName payload)
@ -442,9 +439,7 @@ retryOrMarkError eventId retryCtx err type' = do
currentTime <- liftIO getCurrentTime currentTime <- liftIO getCurrentTime
let delay = let delay =
fromMaybe fromMaybe
( round $ ( round $ unrefine (strcRetryIntervalSeconds retryConf)
Numeric.unNonNegativeDiffTime $
strcRetryIntervalSeconds retryConf
) )
mRetryHeaderSeconds mRetryHeaderSeconds
diff = fromIntegral delay diff = fromIntegral delay

18
server/src-lib/Hasura/GraphQL/Execute/Subscription/Options.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module Hasura.GraphQL.Execute.Subscription.Options module Hasura.GraphQL.Execute.Subscription.Options
( SubscriptionsOptions (..), ( SubscriptionsOptions (..),
LiveQueriesOptions, LiveQueriesOptions,
@ -11,9 +13,9 @@ module Hasura.GraphQL.Execute.Subscription.Options
where where
import Data.Aeson qualified as J import Data.Aeson qualified as J
import Hasura.Base.Instances ()
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric (NonNegativeDiffTime, NonNegativeInt) import Refined (NonNegative, Refined, refineFail, refineTH)
import Hasura.RQL.Types.Numeric qualified as Numeric
data SubscriptionsOptions = SubscriptionsOptions data SubscriptionsOptions = SubscriptionsOptions
{ _lqoBatchSize :: !BatchSize, { _lqoBatchSize :: !BatchSize,
@ -28,8 +30,8 @@ type StreamQueriesOptions = SubscriptionsOptions
mkSubscriptionsOptions :: Maybe BatchSize -> Maybe RefetchInterval -> SubscriptionsOptions mkSubscriptionsOptions :: Maybe BatchSize -> Maybe RefetchInterval -> SubscriptionsOptions
mkSubscriptionsOptions batchSize refetchInterval = mkSubscriptionsOptions batchSize refetchInterval =
SubscriptionsOptions SubscriptionsOptions
{ _lqoBatchSize = fromMaybe (BatchSize $ Numeric.unsafeNonNegativeInt 100) batchSize, { _lqoBatchSize = fromMaybe (BatchSize $$(refineTH 100)) batchSize,
_lqoRefetchInterval = fromMaybe (RefetchInterval 1) refetchInterval _lqoRefetchInterval = fromMaybe (RefetchInterval $$(refineTH 1)) refetchInterval
} }
instance J.ToJSON SubscriptionsOptions where instance J.ToJSON SubscriptionsOptions where
@ -44,16 +46,16 @@ instance J.FromJSON SubscriptionsOptions where
SubscriptionsOptions <$> o J..: "batch_size" SubscriptionsOptions <$> o J..: "batch_size"
<*> o J..: "refetch_delay" <*> o J..: "refetch_delay"
newtype BatchSize = BatchSize {unBatchSize :: NonNegativeInt} newtype BatchSize = BatchSize {unBatchSize :: Refined NonNegative Int}
deriving (Show, Eq, J.ToJSON, J.FromJSON) deriving (Show, Eq, J.ToJSON, J.FromJSON)
mkBatchSize :: Int -> Maybe BatchSize mkBatchSize :: Int -> Maybe BatchSize
mkBatchSize x = BatchSize <$> Numeric.mkNonNegativeInt x mkBatchSize x = BatchSize <$> refineFail x
-- TODO this is treated as milliseconds in fromEnv and as seconds in ToJSON. -- TODO this is treated as milliseconds in fromEnv and as seconds in ToJSON.
-- ideally this would have e.g. ... unRefetchInterval :: Milliseconds -- ideally this would have e.g. ... unRefetchInterval :: Milliseconds
newtype RefetchInterval = RefetchInterval {unRefetchInterval :: NonNegativeDiffTime} newtype RefetchInterval = RefetchInterval {unRefetchInterval :: Refined NonNegative DiffTime}
deriving (Show, Eq, J.ToJSON, J.FromJSON) deriving (Show, Eq, J.ToJSON, J.FromJSON)
mkRefetchInterval :: DiffTime -> Maybe RefetchInterval mkRefetchInterval :: DiffTime -> Maybe RefetchInterval
mkRefetchInterval x = RefetchInterval <$> Numeric.mkNonNegativeDiffTime x mkRefetchInterval x = RefetchInterval <$> refineFail x

4
server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/LiveQuery.hs
View File

@ -29,9 +29,9 @@ import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common (SourceName) import Hasura.RQL.Types.Common (SourceName)
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.Subscription (SubscriptionType (..)) import Hasura.RQL.Types.Subscription (SubscriptionType (..))
import Hasura.Session import Hasura.Session
import Refined (unrefine)
pushResultToCohort :: pushResultToCohort ::
GQResult BS.ByteString -> GQResult BS.ByteString ->
@ -90,7 +90,7 @@ pollLiveQuery pollerId lqOpts (sourceName, sourceConfig) roleName parameterizedQ
cohorts <- STM.atomically $ TMap.toList cohortMap cohorts <- STM.atomically $ TMap.toList cohortMap
cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts
-- cohorts are broken down into batches specified by the batch size -- cohorts are broken down into batches specified by the batch size
let cohortBatches = chunksOf (Numeric.getNonNegativeInt (unBatchSize batchSize)) cohortSnapshots let cohortBatches = chunksOf (unrefine (unBatchSize batchSize)) cohortSnapshots
-- associating every batch with their BatchId -- associating every batch with their BatchId
pure $ zip (BatchId <$> [1 ..]) cohortBatches pure $ zip (BatchId <$> [1 ..]) cohortBatches

4
server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/StreamingQuery.hs
View File

@ -33,11 +33,11 @@ import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common (SourceName) import Hasura.RQL.Types.Common (SourceName)
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.Subscription (SubscriptionType (..)) import Hasura.RQL.Types.Subscription (SubscriptionType (..))
import Hasura.SQL.Value (TxtEncodedVal (..)) import Hasura.SQL.Value (TxtEncodedVal (..))
import Hasura.Session import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G import Language.GraphQL.Draft.Syntax qualified as G
import Refined (unrefine)
import Text.Shakespeare.Text (st) import Text.Shakespeare.Text (st)
{- Note [Streaming subscriptions rebuilding cohort map] {- Note [Streaming subscriptions rebuilding cohort map]
@ -250,7 +250,7 @@ pollStreamingQuery pollerId lqOpts (sourceName, sourceConfig) roleName parameter
cohorts <- STM.atomically $ TMap.toList cohortMap cohorts <- STM.atomically $ TMap.toList cohortMap
cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts
-- cohorts are broken down into batches specified by the batch size -- cohorts are broken down into batches specified by the batch size
let cohortBatches = chunksOf (Numeric.getNonNegativeInt (unBatchSize batchSize)) cohortSnapshots let cohortBatches = chunksOf (unrefine (unBatchSize batchSize)) cohortSnapshots
-- associating every batch with their BatchId -- associating every batch with their BatchId
pure $ zip (BatchId <$> [1 ..]) cohortBatches pure $ zip (BatchId <$> [1 ..]) cohortBatches

6
server/src-lib/Hasura/GraphQL/Execute/Subscription/State.hs
View File

@ -49,11 +49,11 @@ import Hasura.Logging qualified as L
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Action import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Common (SourceName) import Hasura.RQL.Types.Common (SourceName)
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Metrics (ServerMetrics (..)) import Hasura.Server.Metrics (ServerMetrics (..))
import Hasura.Server.Prometheus (PrometheusMetrics (..)) import Hasura.Server.Prometheus (PrometheusMetrics (..))
import Hasura.Server.Types (RequestId) import Hasura.Server.Types (RequestId)
import Language.GraphQL.Draft.Syntax qualified as G import Language.GraphQL.Draft.Syntax qualified as G
import Refined (unrefine)
import StmContainers.Map qualified as STMMap import StmContainers.Map qualified as STMMap
import System.Metrics.Gauge qualified as EKG.Gauge import System.Metrics.Gauge qualified as EKG.Gauge
import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge
@ -198,7 +198,7 @@ addLiveQuery
threadRef <- forkImmortal ("pollLiveQuery." <> show pollerId) logger $ threadRef <- forkImmortal ("pollLiveQuery." <> show pollerId) logger $
forever $ do forever $ do
pollLiveQuery @b pollerId lqOpts (source, sourceConfig) role parameterizedQueryHash query (_pCohorts poller) postPollHook pollLiveQuery @b pollerId lqOpts (source, sourceConfig) role parameterizedQueryHash query (_pCohorts poller) postPollHook
sleep $ Numeric.unNonNegativeDiffTime $ unRefetchInterval refetchInterval sleep $ unrefine $ unRefetchInterval refetchInterval
let !pState = PollerIOState threadRef pollerId let !pState = PollerIOState threadRef pollerId
$assertNFHere pState -- so we don't write thunks to mutable vars $assertNFHere pState -- so we don't write thunks to mutable vars
STM.atomically $ STM.putTMVar (_pIOState poller) pState STM.atomically $ STM.putTMVar (_pIOState poller) pState
@ -288,7 +288,7 @@ addStreamSubscriptionQuery
threadRef <- forkImmortal ("pollStreamingQuery." <> show (unPollerId pollerId)) logger $ threadRef <- forkImmortal ("pollStreamingQuery." <> show (unPollerId pollerId)) logger $
forever $ do forever $ do
pollStreamingQuery @b pollerId streamQOpts (source, sourceConfig) role parameterizedQueryHash query (_pCohorts handler) rootFieldName postPollHook Nothing pollStreamingQuery @b pollerId streamQOpts (source, sourceConfig) role parameterizedQueryHash query (_pCohorts handler) rootFieldName postPollHook Nothing
sleep $ Numeric.unNonNegativeDiffTime $ unRefetchInterval refetchInterval sleep $ unrefine $ unRefetchInterval refetchInterval
let !pState = PollerIOState threadRef pollerId let !pState = PollerIOState threadRef pollerId
$assertNFHere pState -- so we don't write thunks to mutable vars $assertNFHere pState -- so we don't write thunks to mutable vars
STM.atomically $ STM.putTMVar (_pIOState handler) pState STM.atomically $ STM.putTMVar (_pIOState handler) pState

4
server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs
View File

@ -65,7 +65,6 @@ import Hasura.GraphQL.Transport.WebSocket.Types
import Hasura.Logging qualified as L import Hasura.Logging qualified as L
import Hasura.Metadata.Class import Hasura.Metadata.Class
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.RemoteSchema import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.ResultCustomization import Hasura.RQL.Types.ResultCustomization
import Hasura.RQL.Types.SchemaCache (scApiLimits) import Hasura.RQL.Types.SchemaCache (scApiLimits)
@ -96,6 +95,7 @@ import ListT qualified
import Network.HTTP.Client qualified as HTTP import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP import Network.HTTP.Types qualified as HTTP
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Refined (unrefine)
import StmContainers.Map qualified as STMMap import StmContainers.Map qualified as STMMap
import System.Metrics.Prometheus.Counter qualified as Prometheus.Counter import System.Metrics.Prometheus.Counter qualified as Prometheus.Counter
import System.Metrics.Prometheus.Histogram qualified as Prometheus.Histogram import System.Metrics.Prometheus.Histogram qualified as Prometheus.Histogram
@ -299,7 +299,7 @@ onConn wsId requestHead ipAddress onConnHActions = do
liftIO $ liftIO $
forever $ do forever $ do
kaAction wsConn kaAction wsConn
sleep $ seconds (Numeric.getNonNegative $ unKeepAliveDelay keepAliveDelay) sleep $ seconds (unrefine $ unKeepAliveDelay keepAliveDelay)
tokenExpiryHandler wsConn = do tokenExpiryHandler wsConn = do
expTime <- liftIO $ expTime <- liftIO $

4
server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs
View File

@ -57,11 +57,11 @@ import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.GraphQL.Transport.WebSocket.Protocol import Hasura.GraphQL.Transport.WebSocket.Protocol
import Hasura.Logging qualified as L import Hasura.Logging qualified as L
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Init.Config (WSConnectionInitTimeout (..)) import Hasura.Server.Init.Config (WSConnectionInitTimeout (..))
import ListT qualified import ListT qualified
import Network.Wai.Extended (IpAddress) import Network.Wai.Extended (IpAddress)
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Refined (unrefine)
import StmContainers.Map qualified as STMMap import StmContainers.Map qualified as STMMap
import System.IO.Error qualified as E import System.IO.Error qualified as E
@ -309,7 +309,7 @@ createServerApp wsConnInitTimeout (WSServer logger@(L.Logger writeLog) serverSta
logWSLog logger $ WSLog wsId EConnectionRequest Nothing logWSLog logger $ WSLog wsId EConnectionRequest Nothing
-- NOTE: this timer is specific to `graphql-ws`. the server has to close the connection -- NOTE: this timer is specific to `graphql-ws`. the server has to close the connection
-- if the client doesn't send a `connection_init` message within the timeout period -- if the client doesn't send a `connection_init` message within the timeout period
wsConnInitTimer <- liftIO $ getNewWSTimer (Numeric.getNonNegative $ unWSConnectionInitTimeout wsConnInitTimeout) wsConnInitTimer <- liftIO $ getNewWSTimer (unrefine $ unWSConnectionInitTimeout wsConnInitTimeout)
status <- liftIO $ STM.readTVarIO serverStatus status <- liftIO $ STM.readTVarIO serverStatus
case status of case status of
AcceptingConns _ -> logUnexpectedExceptions $ do AcceptingConns _ -> logUnexpectedExceptions $ do

4
server/src-lib/Hasura/Incremental/Internal/Dependency.hs
View File

@ -51,6 +51,7 @@ import Hasura.Incremental.Select
import Hasura.Prelude import Hasura.Prelude
import Language.GraphQL.Draft.Syntax qualified as G import Language.GraphQL.Draft.Syntax qualified as G
import Network.URI.Extended qualified as N import Network.URI.Extended qualified as N
import Refined (Refined, unrefine)
import Servant.Client (BaseUrl, Scheme) import Servant.Client (BaseUrl, Scheme)
import System.Cron.Types import System.Cron.Types
@ -127,6 +128,9 @@ class (Eq a) => Cacheable a where
instance (Cacheable a) => Cacheable (NESeq a) where instance (Cacheable a) => Cacheable (NESeq a) where
unchanged access = unchanged access `on` NESeq.toSeq unchanged access = unchanged access `on` NESeq.toSeq
instance (Cacheable a) => Cacheable (Refined p a) where
unchanged access = unchanged access `on` unrefine
-- | A mapping from root 'Dependency' keys to the accesses made against those dependencies. -- | A mapping from root 'Dependency' keys to the accesses made against those dependencies.
newtype Accesses = Accesses {unAccesses :: DM.DMap UniqueS Access} newtype Accesses = Accesses {unAccesses :: DM.DMap UniqueS Access}

101
server/src-lib/Hasura/RQL/Types/Numeric.hs
View File

@ -1,101 +0,0 @@
{-# LANGUAGE ViewPatterns #-}
-- | Utility types relating to numeric values
module Hasura.RQL.Types.Numeric
( NonNegative,
getNonNegative,
mkNonNegative,
unsafeNonNegative,
NonNegativeInt,
getNonNegativeInt,
mkNonNegativeInt,
unsafeNonNegativeInt,
PositiveInt,
getPositiveInt,
mkPositiveInt,
unsafePositiveInt,
NonNegativeDiffTime,
unNonNegativeDiffTime,
unsafeNonNegativeDiffTime,
mkNonNegativeDiffTime,
)
where
--------------------------------------------------------------------------------
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as Aeson
import Data.Scientific qualified as Scientific
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
--------------------------------------------------------------------------------
newtype NonNegative a = NonNegative {getNonNegative :: a}
deriving stock (Functor)
deriving newtype (Show, Eq, Ord, ToJSON, Generic, NFData, Cacheable, Hashable)
mkNonNegative :: (Ord a, Num a) => a -> Maybe (NonNegative a)
mkNonNegative x = case x >= 0 of
True -> Just $ NonNegative x
False -> Nothing
unsafeNonNegative :: a -> NonNegative a
unsafeNonNegative = NonNegative
instance (Fractional a, FromJSON a) => FromJSON (NonNegative a) where
parseJSON = Aeson.withScientific "NonNegative" $ \t -> do
case t >= 0 of
True -> pure $ NonNegative . realToFrac $ t
False -> fail "negative value not allowed"
newtype NonNegativeInt = NonNegativeInt {getNonNegativeInt :: Int}
deriving (Show, Eq, ToJSON, Generic, NFData, Cacheable, Hashable)
mkNonNegativeInt :: Int -> Maybe NonNegativeInt
mkNonNegativeInt x = case x >= 0 of
True -> Just $ NonNegativeInt x
False -> Nothing
unsafeNonNegativeInt :: Int -> NonNegativeInt
unsafeNonNegativeInt = NonNegativeInt
instance FromJSON NonNegativeInt where
parseJSON = Aeson.withScientific "NonNegativeInt" $ \t -> do
case t >= 0 of
True -> maybe (fail "integer passed is out of bounds") (pure . NonNegativeInt) $ Scientific.toBoundedInteger t
False -> fail "negative value not allowed"
newtype PositiveInt = PositiveInt {getPositiveInt :: Int}
deriving (Show, Eq, ToJSON, Generic, NFData, Cacheable, Hashable)
mkPositiveInt :: Int -> Maybe PositiveInt
mkPositiveInt x = case x > 0 of
True -> Just $ PositiveInt x
False -> Nothing
unsafePositiveInt :: Int -> PositiveInt
unsafePositiveInt = PositiveInt
instance FromJSON PositiveInt where
parseJSON = Aeson.withScientific "NonNegativeInt" $ \t -> do
case t > 0 of
True -> maybe (fail "integer passed is out of bounds") (pure . PositiveInt) $ Scientific.toBoundedInteger t
False -> fail "integer passed is out of bounds"
newtype NonNegativeDiffTime = NonNegativeDiffTime {unNonNegativeDiffTime :: DiffTime}
deriving (Show, Eq, ToJSON, Generic, NFData, Cacheable, Num)
unsafeNonNegativeDiffTime :: DiffTime -> NonNegativeDiffTime
unsafeNonNegativeDiffTime = NonNegativeDiffTime
mkNonNegativeDiffTime :: DiffTime -> Maybe NonNegativeDiffTime
mkNonNegativeDiffTime x = case x >= 0 of
True -> Just $ NonNegativeDiffTime x
False -> Nothing
instance FromJSON NonNegativeDiffTime where
parseJSON = Aeson.withScientific "NonNegativeDiffTime" $ \t -> do
case t >= 0 of
True -> return $ NonNegativeDiffTime . realToFrac $ t
False -> fail "negative value not allowed"

20
server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs
View File

@ -61,8 +61,8 @@ import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTrans
import Hasura.RQL.Types.Common (InputWebhook (..)) import Hasura.RQL.Types.Common (InputWebhook (..))
import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Eventing import Hasura.RQL.Types.Eventing
import Hasura.RQL.Types.Numeric (NonNegativeDiffTime, unsafeNonNegativeDiffTime)
import PostgreSQL.Binary.Decoding qualified as PD import PostgreSQL.Binary.Decoding qualified as PD
import Refined (NonNegative, Refined, refineTH)
import System.Cron.Types import System.Cron.Types
type CronEventId = EventId type CronEventId = EventId
@ -75,14 +75,14 @@ type InvocationId = Text
data STRetryConf = STRetryConf data STRetryConf = STRetryConf
{ strcNumRetries :: Int, { strcNumRetries :: Int,
strcRetryIntervalSeconds :: NonNegativeDiffTime, strcRetryIntervalSeconds :: Refined NonNegative DiffTime,
strcTimeoutSeconds :: NonNegativeDiffTime, strcTimeoutSeconds :: Refined NonNegative DiffTime,
-- | The tolerance configuration is used to determine whether a scheduled -- | The tolerance configuration is used to determine whether a scheduled
-- event is not too old to process. The age of the scheduled event is the -- event is not too old to process. The age of the scheduled event is the
-- difference between the current timestamp and the scheduled event's -- difference between the current timestamp and the scheduled event's
-- timestamp, if the age is than the tolerance then the scheduled event -- timestamp, if the age is than the tolerance then the scheduled event
-- is marked as dead. -- is marked as dead.
strcToleranceSeconds :: NonNegativeDiffTime strcToleranceSeconds :: Refined NonNegative DiffTime
} }
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
@ -94,11 +94,11 @@ instance FromJSON STRetryConf where
parseJSON = withObject "STRetryConf" \o -> do parseJSON = withObject "STRetryConf" \o -> do
numRetries' <- o .:? "num_retries" .!= 0 numRetries' <- o .:? "num_retries" .!= 0
retryInterval <- retryInterval <-
o .:? "retry_interval_seconds" .!= unsafeNonNegativeDiffTime (seconds 10) o .:? "retry_interval_seconds" .!= $$(refineTH @NonNegative @DiffTime (seconds 10))
timeout <- timeout <-
o .:? "timeout_seconds" .!= unsafeNonNegativeDiffTime (seconds 60) o .:? "timeout_seconds" .!= $$(refineTH @NonNegative @DiffTime (seconds 60))
tolerance <- tolerance <-
o .:? "tolerance_seconds" .!= unsafeNonNegativeDiffTime (hours 6) o .:? "tolerance_seconds" .!= $$(refineTH @NonNegative @DiffTime (hours 6))
if numRetries' < 0 if numRetries' < 0
then fail "num_retries cannot be a negative value" then fail "num_retries cannot be a negative value"
else pure $ STRetryConf numRetries' retryInterval timeout tolerance else pure $ STRetryConf numRetries' retryInterval timeout tolerance
@ -109,9 +109,9 @@ defaultSTRetryConf :: STRetryConf
defaultSTRetryConf = defaultSTRetryConf =
STRetryConf STRetryConf
{ strcNumRetries = 0, { strcNumRetries = 0,
strcRetryIntervalSeconds = unsafeNonNegativeDiffTime $ seconds 10, strcRetryIntervalSeconds = $$(refineTH (seconds 10)),
strcTimeoutSeconds = unsafeNonNegativeDiffTime $ seconds 60, strcTimeoutSeconds = $$(refineTH (seconds 60)),
strcToleranceSeconds = unsafeNonNegativeDiffTime $ hours 6 strcToleranceSeconds = $$(refineTH (hours 6))
} }
data CronTriggerMetadata = CronTriggerMetadata data CronTriggerMetadata = CronTriggerMetadata

12
server/src-lib/Hasura/Server/Init.hs
View File

@ -36,7 +36,6 @@ import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Common qualified as Common import Hasura.RQL.Types.Common qualified as Common
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init.Arg import Hasura.Server.Init.Arg
@ -46,6 +45,7 @@ import Hasura.Server.Init.Logging
import Hasura.Server.Logging qualified as Server.Logging import Hasura.Server.Logging qualified as Server.Logging
import Hasura.Server.Types qualified as Types import Hasura.Server.Types qualified as Types
import Network.WebSockets qualified as WebSockets import Network.WebSockets qualified as WebSockets
import Refined (unrefine)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- TODO(SOLOMON): Where does this note belong? -- TODO(SOLOMON): Where does this note belong?
@ -207,19 +207,19 @@ mkServeOptions ServeOptionsRaw {..} = do
pure ServeOptions {..} pure ServeOptions {..}
where where
mkConnParams ConnParamsRaw {..} = do mkConnParams ConnParamsRaw {..} = do
cpStripes <- Numeric.getNonNegativeInt <$> withOptionDefault rcpStripes pgStripesOption cpStripes <- unrefine <$> withOptionDefault rcpStripes pgStripesOption
-- Note: by Little's Law we can expect e.g. (with 50 max connections) a -- Note: by Little's Law we can expect e.g. (with 50 max connections) a
-- hard throughput cap at 1000RPS when db queries take 50ms on average: -- hard throughput cap at 1000RPS when db queries take 50ms on average:
cpConns <- Numeric.getNonNegativeInt <$> withOptionDefault rcpConns pgConnsOption cpConns <- unrefine <$> withOptionDefault rcpConns pgConnsOption
cpIdleTime <- Numeric.getNonNegativeInt <$> withOptionDefault rcpIdleTime pgTimeoutOption cpIdleTime <- unrefine <$> withOptionDefault rcpIdleTime pgTimeoutOption
cpAllowPrepare <- withOptionDefault rcpAllowPrepare pgUsePreparedStatementsOption cpAllowPrepare <- withOptionDefault rcpAllowPrepare pgUsePreparedStatementsOption
-- TODO: Add newtype to allow this: -- TODO: Add newtype to allow this:
cpMbLifetime <- do cpMbLifetime <- do
lifetime <- Numeric.getNonNegative <$> withOptionDefault rcpConnLifetime pgConnLifetimeOption lifetime <- unrefine <$> withOptionDefault rcpConnLifetime pgConnLifetimeOption
if lifetime == 0 if lifetime == 0
then pure Nothing then pure Nothing
else pure (Just lifetime) else pure (Just lifetime)
cpTimeout <- fmap Numeric.getNonNegative <$> withOption rcpPoolTimeout pgPoolTimeoutOption cpTimeout <- fmap unrefine <$> withOption rcpPoolTimeout pgPoolTimeoutOption
let cpCancel = True let cpCancel = True
return $ return $
Query.ConnParams {..} Query.ConnParams {..}

70
server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
-- | The Arg Opt.Parser for the 'serve' subcommand. -- | The Arg Opt.Parser for the 'serve' subcommand.
module Hasura.Server.Init.Arg.Command.Serve module Hasura.Server.Init.Arg.Command.Serve
( -- * Opt.Parser ( -- * Opt.Parser
@ -72,7 +74,6 @@ import Hasura.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init.Arg.PrettyPrinter qualified as PP import Hasura.Server.Init.Arg.PrettyPrinter qualified as PP
@ -83,6 +84,7 @@ import Hasura.Server.Types qualified as Types
import Hasura.Session qualified as Session import Hasura.Session qualified as Session
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import Options.Applicative qualified as Opt import Options.Applicative qualified as Opt
import Refined (NonNegative, Positive, Refined, refineTH)
import Witch qualified import Witch qualified
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -176,7 +178,7 @@ parseConnParams :: Opt.Parser Config.ConnParamsRaw
parseConnParams = parseConnParams =
Config.ConnParamsRaw <$> pgStripes <*> pgConns <*> pgIdleTimeout <*> pgConnLifetime <*> pgUsePreparedStatements <*> pgPoolTimeout Config.ConnParamsRaw <$> pgStripes <*> pgConns <*> pgIdleTimeout <*> pgConnLifetime <*> pgUsePreparedStatements <*> pgPoolTimeout
where where
pgStripes :: Opt.Parser (Maybe Numeric.NonNegativeInt) pgStripes :: Opt.Parser (Maybe (Refined NonNegative Int))
pgStripes = pgStripes =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -187,7 +189,7 @@ parseConnParams =
<> Opt.help (Config._helpMessage pgStripesOption) <> Opt.help (Config._helpMessage pgStripesOption)
) )
pgConns :: Opt.Parser (Maybe Numeric.NonNegativeInt) pgConns :: Opt.Parser (Maybe (Refined NonNegative Int))
pgConns = pgConns =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -198,7 +200,7 @@ parseConnParams =
<> Opt.help (Config._helpMessage pgConnsOption) <> Opt.help (Config._helpMessage pgConnsOption)
) )
pgIdleTimeout :: Opt.Parser (Maybe Numeric.NonNegativeInt) pgIdleTimeout :: Opt.Parser (Maybe (Refined NonNegative Int))
pgIdleTimeout = pgIdleTimeout =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -208,7 +210,7 @@ parseConnParams =
<> Opt.help (Config._helpMessage pgTimeoutOption) <> Opt.help (Config._helpMessage pgTimeoutOption)
) )
pgConnLifetime :: Opt.Parser (Maybe (Numeric.NonNegative Time.NominalDiffTime)) pgConnLifetime :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime))
pgConnLifetime = pgConnLifetime =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -228,7 +230,7 @@ parseConnParams =
<> Opt.help (Config._helpMessage pgUsePreparedStatementsOption) <> Opt.help (Config._helpMessage pgUsePreparedStatementsOption)
) )
pgPoolTimeout :: Opt.Parser (Maybe (Numeric.NonNegative Time.NominalDiffTime)) pgPoolTimeout :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime))
pgPoolTimeout = pgPoolTimeout =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -238,20 +240,20 @@ parseConnParams =
<> Opt.help (Config._helpMessage pgPoolTimeoutOption) <> Opt.help (Config._helpMessage pgPoolTimeoutOption)
) )
pgStripesOption :: Config.Option Numeric.NonNegativeInt pgStripesOption :: Config.Option (Refined NonNegative Int)
pgStripesOption = pgStripesOption =
Config.Option Config.Option
{ _default = Numeric.unsafeNonNegativeInt 1, { _default = $$(refineTH 1),
_envVar = "HASURA_GRAPHQL_PG_STRIPES", _envVar = "HASURA_GRAPHQL_PG_STRIPES",
_helpMessage = _helpMessage =
"Number of stripes (distinct sub-pools) to maintain with Postgres (default: 1). " "Number of stripes (distinct sub-pools) to maintain with Postgres (default: 1). "
<> "New connections will be taken from a particular stripe pseudo-randomly." <> "New connections will be taken from a particular stripe pseudo-randomly."
} }
pgConnsOption :: Config.Option Numeric.NonNegativeInt pgConnsOption :: Config.Option (Refined NonNegative Int)
pgConnsOption = pgConnsOption =
Config.Option Config.Option
{ _default = Numeric.unsafeNonNegativeInt 50, { _default = $$(refineTH 50),
_envVar = "HASURA_GRAPHQL_PG_CONNECTIONS", _envVar = "HASURA_GRAPHQL_PG_CONNECTIONS",
_helpMessage = _helpMessage =
"Maximum number of Postgres connections that can be opened per stripe (default: 50). " "Maximum number of Postgres connections that can be opened per stripe (default: 50). "
@ -259,18 +261,18 @@ pgConnsOption =
<> "even if there is capacity in other stripes." <> "even if there is capacity in other stripes."
} }
pgTimeoutOption :: Config.Option Numeric.NonNegativeInt pgTimeoutOption :: Config.Option (Refined NonNegative Int)
pgTimeoutOption = pgTimeoutOption =
Config.Option Config.Option
{ _default = Numeric.unsafeNonNegativeInt 180, { _default = $$(refineTH 180),
_envVar = "HASURA_GRAPHQL_PG_TIMEOUT", _envVar = "HASURA_GRAPHQL_PG_TIMEOUT",
_helpMessage = "Each connection's idle time before it is closed (default: 180 sec)" _helpMessage = "Each connection's idle time before it is closed (default: 180 sec)"
} }
pgConnLifetimeOption :: Config.Option (Numeric.NonNegative Time.NominalDiffTime) pgConnLifetimeOption :: Config.Option (Refined NonNegative Time.NominalDiffTime)
pgConnLifetimeOption = pgConnLifetimeOption =
Config.Option Config.Option
{ _default = Numeric.unsafeNonNegative 600, { _default = $$(refineTH 600),
_envVar = "HASURA_GRAPHQL_PG_CONN_LIFETIME", _envVar = "HASURA_GRAPHQL_PG_CONN_LIFETIME",
_helpMessage = _helpMessage =
"Time from connection creation after which the connection should be destroyed and a new one " "Time from connection creation after which the connection should be destroyed and a new one "
@ -605,7 +607,7 @@ parseMxRefetchDelay =
mxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval mxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval
mxRefetchDelayOption = mxRefetchDelayOption =
Config.Option Config.Option
{ Config._default = Subscription.Options.RefetchInterval 1, { Config._default = Subscription.Options.RefetchInterval $$(refineTH 1),
Config._envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_REFETCH_INTERVAL", Config._envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_REFETCH_INTERVAL",
Config._helpMessage = Config._helpMessage =
"results will only be sent once in this interval (in milliseconds) for " "results will only be sent once in this interval (in milliseconds) for "
@ -625,7 +627,7 @@ parseMxBatchSize =
mxBatchSizeOption :: Config.Option Subscription.Options.BatchSize mxBatchSizeOption :: Config.Option Subscription.Options.BatchSize
mxBatchSizeOption = mxBatchSizeOption =
Config.Option Config.Option
{ _default = Subscription.Options.BatchSize $ Numeric.unsafeNonNegativeInt 100, { _default = Subscription.Options.BatchSize $$(refineTH 100),
_envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_BATCH_SIZE", _envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_BATCH_SIZE",
_helpMessage = _helpMessage =
"multiplexed live queries are split into batches of the specified " "multiplexed live queries are split into batches of the specified "
@ -645,7 +647,7 @@ parseStreamingMxRefetchDelay =
streamingMxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval streamingMxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval
streamingMxRefetchDelayOption = streamingMxRefetchDelayOption =
Config.Option Config.Option
{ Config._default = Subscription.Options.RefetchInterval 1, { Config._default = Subscription.Options.RefetchInterval $$(refineTH 1),
Config._envVar = "HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_REFETCH_INTERVAL", Config._envVar = "HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_REFETCH_INTERVAL",
Config._helpMessage = Config._helpMessage =
"results will only be sent once in this interval (in milliseconds) for " "results will only be sent once in this interval (in milliseconds) for "
@ -665,7 +667,7 @@ parseStreamingMxBatchSize =
streamingMxBatchSizeOption :: Config.Option Subscription.Options.BatchSize streamingMxBatchSizeOption :: Config.Option Subscription.Options.BatchSize
streamingMxBatchSizeOption = streamingMxBatchSizeOption =
Config.Option Config.Option
{ Config._default = Subscription.Options.BatchSize $ Numeric.unsafeNonNegativeInt 100, { Config._default = Subscription.Options.BatchSize $$(refineTH 100),
Config._envVar = "HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_BATCH_SIZE", Config._envVar = "HASURA_GRAPHQL_STREAMING_QUERIES_MULTIPLEXED_BATCH_SIZE",
Config._helpMessage = Config._helpMessage =
"multiplexed live queries are split into batches of the specified " "multiplexed live queries are split into batches of the specified "
@ -777,7 +779,7 @@ graphqlAdminInternalErrorsOption =
Config._helpMessage = "Enables including 'internal' information in an error response for requests made by an 'admin' (default: true)" Config._helpMessage = "Enables including 'internal' information in an error response for requests made by an 'admin' (default: true)"
} }
parseGraphqlEventsHttpPoolSize :: Opt.Parser (Maybe Numeric.PositiveInt) parseGraphqlEventsHttpPoolSize :: Opt.Parser (Maybe (Refined Positive Int))
parseGraphqlEventsHttpPoolSize = parseGraphqlEventsHttpPoolSize =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -787,15 +789,15 @@ parseGraphqlEventsHttpPoolSize =
<> Opt.help (Config._helpMessage graphqlEventsHttpPoolSizeOption) <> Opt.help (Config._helpMessage graphqlEventsHttpPoolSizeOption)
) )
graphqlEventsHttpPoolSizeOption :: Config.Option Numeric.PositiveInt graphqlEventsHttpPoolSizeOption :: Config.Option (Refined Positive Int)
graphqlEventsHttpPoolSizeOption = graphqlEventsHttpPoolSizeOption =
Config.Option Config.Option
{ Config._default = Numeric.unsafePositiveInt 100, { Config._default = $$(refineTH 100),
Config._envVar = "HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE", Config._envVar = "HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE",
Config._helpMessage = "Max event processing threads (default: 100)" Config._helpMessage = "Max event processing threads (default: 100)"
} }
parseGraphqlEventsFetchInterval :: Opt.Parser (Maybe (Numeric.NonNegative Milliseconds)) parseGraphqlEventsFetchInterval :: Opt.Parser (Maybe (Refined NonNegative Milliseconds))
parseGraphqlEventsFetchInterval = parseGraphqlEventsFetchInterval =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -805,10 +807,10 @@ parseGraphqlEventsFetchInterval =
<> Opt.help (Config._helpMessage graphqlEventsFetchIntervalOption) <> Opt.help (Config._helpMessage graphqlEventsFetchIntervalOption)
) )
graphqlEventsFetchIntervalOption :: Config.Option (Numeric.NonNegative Milliseconds) graphqlEventsFetchIntervalOption :: Config.Option (Refined NonNegative Milliseconds)
graphqlEventsFetchIntervalOption = graphqlEventsFetchIntervalOption =
Config.Option Config.Option
{ Config._default = Numeric.unsafeNonNegative (1000 :: Milliseconds), { Config._default = $$(refineTH 1000),
Config._envVar = "HASURA_GRAPHQL_EVENTS_FETCH_INTERVAL", Config._envVar = "HASURA_GRAPHQL_EVENTS_FETCH_INTERVAL",
Config._helpMessage = "Interval in milliseconds to sleep before trying to fetch events again after a fetch returned no events from postgres (default: 1 second)." Config._helpMessage = "Interval in milliseconds to sleep before trying to fetch events again after a fetch returned no events from postgres (default: 1 second)."
} }
@ -826,7 +828,7 @@ parseGraphqlAsyncActionsFetchInterval =
asyncActionsFetchIntervalOption :: Config.Option Config.OptionalInterval asyncActionsFetchIntervalOption :: Config.Option Config.OptionalInterval
asyncActionsFetchIntervalOption = asyncActionsFetchIntervalOption =
Config.Option Config.Option
{ Config._default = Config.Interval $ Numeric.unsafeNonNegative (1000 :: Milliseconds), { Config._default = Config.Interval $$(refineTH 1000),
Config._envVar = "HASURA_GRAPHQL_ASYNC_ACTIONS_FETCH_INTERVAL", Config._envVar = "HASURA_GRAPHQL_ASYNC_ACTIONS_FETCH_INTERVAL",
Config._helpMessage = Config._helpMessage =
"Interval in milliseconds to sleep before trying to fetch new async actions. " "Interval in milliseconds to sleep before trying to fetch new async actions. "
@ -878,7 +880,7 @@ parseWebSocketKeepAlive =
webSocketKeepAliveOption :: Config.Option Config.KeepAliveDelay webSocketKeepAliveOption :: Config.Option Config.KeepAliveDelay
webSocketKeepAliveOption = webSocketKeepAliveOption =
Config.Option Config.Option
{ Config._default = Config.KeepAliveDelay $ Numeric.unsafeNonNegative (5 :: Seconds), { Config._default = Config.KeepAliveDelay $$(refineTH 5),
Config._envVar = "HASURA_GRAPHQL_WEBSOCKET_KEEPALIVE", Config._envVar = "HASURA_GRAPHQL_WEBSOCKET_KEEPALIVE",
Config._helpMessage = "Control websocket keep-alive timeout (default 5 seconds)" Config._helpMessage = "Control websocket keep-alive timeout (default 5 seconds)"
} }
@ -930,7 +932,7 @@ schemaPollIntervalOption :: Config.Option Config.OptionalInterval
schemaPollIntervalOption = schemaPollIntervalOption =
Config.Option Config.Option
{ -- 1000 Milliseconds or 1 Second { -- 1000 Milliseconds or 1 Second
Config._default = Config.Interval $ Numeric.unsafeNonNegative (1000 :: Milliseconds), Config._default = Config.Interval $$(refineTH 1000),
Config._envVar = "HASURA_GRAPHQL_SCHEMA_SYNC_POLL_INTERVAL", Config._envVar = "HASURA_GRAPHQL_SCHEMA_SYNC_POLL_INTERVAL",
Config._helpMessage = "Interval to poll metadata storage for updates in milliseconds - Default 1000 (1s) - Set to 0 to disable" Config._helpMessage = "Interval to poll metadata storage for updates in milliseconds - Default 1000 (1s) - Set to 0 to disable"
} }
@ -959,7 +961,7 @@ experimentalFeaturesOption =
<> "streaming_subscriptions: A streaming subscription streams the response according to the cursor provided by the user" <> "streaming_subscriptions: A streaming subscription streams the response according to the cursor provided by the user"
} }
parseEventsFetchBatchSize :: Opt.Parser (Maybe Numeric.NonNegativeInt) parseEventsFetchBatchSize :: Opt.Parser (Maybe (Refined NonNegative Int))
parseEventsFetchBatchSize = parseEventsFetchBatchSize =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -969,17 +971,17 @@ parseEventsFetchBatchSize =
<> Opt.help (Config._helpMessage eventsFetchBatchSizeOption) <> Opt.help (Config._helpMessage eventsFetchBatchSizeOption)
) )
eventsFetchBatchSizeOption :: Config.Option Numeric.NonNegativeInt eventsFetchBatchSizeOption :: Config.Option (Refined NonNegative Int)
eventsFetchBatchSizeOption = eventsFetchBatchSizeOption =
Config.Option Config.Option
{ Config._default = Numeric.unsafeNonNegativeInt 100, { Config._default = $$(refineTH 100),
Config._envVar = "HASURA_GRAPHQL_EVENTS_FETCH_BATCH_SIZE", Config._envVar = "HASURA_GRAPHQL_EVENTS_FETCH_BATCH_SIZE",
Config._helpMessage = Config._helpMessage =
"The maximum number of events to be fetched from the events table in a single batch. Default 100" "The maximum number of events to be fetched from the events table in a single batch. Default 100"
++ "Value \"0\" implies completely disable fetching events from events table. " ++ "Value \"0\" implies completely disable fetching events from events table. "
} }
parseGracefulShutdownTimeout :: Opt.Parser (Maybe (Numeric.NonNegative Seconds)) parseGracefulShutdownTimeout :: Opt.Parser (Maybe (Refined NonNegative Seconds))
parseGracefulShutdownTimeout = parseGracefulShutdownTimeout =
Opt.optional $ Opt.optional $
Opt.option Opt.option
@ -989,10 +991,10 @@ parseGracefulShutdownTimeout =
<> Opt.help (Config._helpMessage gracefulShutdownOption) <> Opt.help (Config._helpMessage gracefulShutdownOption)
) )
gracefulShutdownOption :: Config.Option (Numeric.NonNegative Seconds) gracefulShutdownOption :: Config.Option (Refined NonNegative Seconds)
gracefulShutdownOption = gracefulShutdownOption =
Config.Option Config.Option
{ Config._default = Numeric.unsafeNonNegative (60 :: Seconds), { Config._default = $$(refineTH 60),
Config._envVar = "HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT", Config._envVar = "HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT",
Config._helpMessage = Config._helpMessage =
"Timeout for graceful shutdown before which in-flight scheduled events, " "Timeout for graceful shutdown before which in-flight scheduled events, "
@ -1012,7 +1014,7 @@ parseWebSocketConnectionInitTimeout =
webSocketConnectionInitTimeoutOption :: Config.Option Config.WSConnectionInitTimeout webSocketConnectionInitTimeoutOption :: Config.Option Config.WSConnectionInitTimeout
webSocketConnectionInitTimeoutOption = webSocketConnectionInitTimeoutOption =
Config.Option Config.Option
{ Config._default = Config.WSConnectionInitTimeout $ Numeric.unsafeNonNegative 3, { Config._default = Config.WSConnectionInitTimeout $$(refineTH 3),
Config._envVar = "HASURA_GRAPHQL_WEBSOCKET_CONNECTION_INIT_TIMEOUT", -- FIXME?: maybe a better name Config._envVar = "HASURA_GRAPHQL_WEBSOCKET_CONNECTION_INIT_TIMEOUT", -- FIXME?: maybe a better name
Config._helpMessage = "Control websocket connection_init timeout (default 3 seconds)" Config._helpMessage = "Control websocket connection_init timeout (default 3 seconds)"
} }

38
server/src-lib/Hasura/Server/Init/Config.hs
View File

@ -81,7 +81,6 @@ import Hasura.Incremental (Cacheable)
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Common qualified as Common import Hasura.RQL.Types.Common qualified as Common
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Logging qualified as Server.Logging import Hasura.Server.Logging qualified as Server.Logging
@ -89,6 +88,7 @@ import Hasura.Server.Types qualified as Server.Types
import Hasura.Session qualified as Session import Hasura.Session qualified as Session
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import Network.WebSockets qualified as WebSockets import Network.WebSockets qualified as WebSockets
import Refined (NonNegative, Positive, Refined, unrefine)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -285,8 +285,8 @@ data ServeOptionsRaw impl = ServeOptionsRaw
rsoLogLevel :: Maybe Logging.LogLevel, rsoLogLevel :: Maybe Logging.LogLevel,
rsoDevMode :: Bool, rsoDevMode :: Bool,
rsoAdminInternalErrors :: Maybe Bool, rsoAdminInternalErrors :: Maybe Bool,
rsoEventsHttpPoolSize :: Maybe Numeric.PositiveInt, rsoEventsHttpPoolSize :: Maybe (Refined Positive Int),
rsoEventsFetchInterval :: Maybe (Numeric.NonNegative Milliseconds), rsoEventsFetchInterval :: Maybe (Refined NonNegative Milliseconds),
rsoAsyncActionsFetchInterval :: Maybe OptionalInterval, rsoAsyncActionsFetchInterval :: Maybe OptionalInterval,
rsoEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions, rsoEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions,
rsoWebSocketCompression :: Bool, rsoWebSocketCompression :: Bool,
@ -296,8 +296,8 @@ data ServeOptionsRaw impl = ServeOptionsRaw
rsoSchemaPollInterval :: Maybe OptionalInterval, rsoSchemaPollInterval :: Maybe OptionalInterval,
-- | See Note '$experimentalFeatures' at bottom of module -- | See Note '$experimentalFeatures' at bottom of module
rsoExperimentalFeatures :: Maybe (HashSet Server.Types.ExperimentalFeature), rsoExperimentalFeatures :: Maybe (HashSet Server.Types.ExperimentalFeature),
rsoEventsFetchBatchSize :: Maybe Numeric.NonNegativeInt, rsoEventsFetchBatchSize :: Maybe (Refined NonNegative Int),
rsoGracefulShutdownTimeout :: Maybe (Numeric.NonNegative Seconds), rsoGracefulShutdownTimeout :: Maybe (Refined NonNegative Seconds),
rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout, rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout,
rsoEnableMetadataQueryLoggingEnv :: Server.Logging.MetadataQueryLoggingMode, rsoEnableMetadataQueryLoggingEnv :: Server.Logging.MetadataQueryLoggingMode,
-- | stores global default naming convention -- | stores global default naming convention
@ -365,12 +365,12 @@ data OptionalInterval
= -- | No polling = -- | No polling
Skip Skip
| -- | Interval time | -- | Interval time
Interval (Numeric.NonNegative Milliseconds) Interval (Refined NonNegative Milliseconds)
deriving (Show, Eq) deriving (Show, Eq)
msToOptionalInterval :: Numeric.NonNegative Milliseconds -> OptionalInterval msToOptionalInterval :: Refined NonNegative Milliseconds -> OptionalInterval
msToOptionalInterval = \case msToOptionalInterval = \case
(Numeric.getNonNegative -> 0) -> Skip (unrefine -> 0) -> Skip
s -> Interval s s -> Interval s
instance FromJSON OptionalInterval where instance FromJSON OptionalInterval where
@ -385,19 +385,19 @@ instance ToJSON OptionalInterval where
-- construct a 'ConnParams' -- construct a 'ConnParams'
data ConnParamsRaw = ConnParamsRaw data ConnParamsRaw = ConnParamsRaw
{ -- NOTE: Should any of these types be 'PositiveInt'? { -- NOTE: Should any of these types be 'PositiveInt'?
rcpStripes :: Maybe Numeric.NonNegativeInt, rcpStripes :: Maybe (Refined NonNegative Int),
rcpConns :: Maybe Numeric.NonNegativeInt, rcpConns :: Maybe (Refined NonNegative Int),
rcpIdleTime :: Maybe Numeric.NonNegativeInt, rcpIdleTime :: Maybe (Refined NonNegative Int),
-- | Time from connection creation after which to destroy a connection and -- | Time from connection creation after which to destroy a connection and
-- choose a different/new one. -- choose a different/new one.
rcpConnLifetime :: Maybe (Numeric.NonNegative Time.NominalDiffTime), rcpConnLifetime :: Maybe (Refined NonNegative Time.NominalDiffTime),
rcpAllowPrepare :: Maybe Bool, rcpAllowPrepare :: Maybe Bool,
-- | See @HASURA_GRAPHQL_PG_POOL_TIMEOUT@ -- | See @HASURA_GRAPHQL_PG_POOL_TIMEOUT@
rcpPoolTimeout :: Maybe (Numeric.NonNegative Time.NominalDiffTime) rcpPoolTimeout :: Maybe (Refined NonNegative Time.NominalDiffTime)
} }
deriving (Show, Eq) deriving (Show, Eq)
newtype KeepAliveDelay = KeepAliveDelay {unKeepAliveDelay :: Numeric.NonNegative Seconds} newtype KeepAliveDelay = KeepAliveDelay {unKeepAliveDelay :: Refined NonNegative Seconds}
deriving (Eq, Show) deriving (Eq, Show)
instance FromJSON KeepAliveDelay where instance FromJSON KeepAliveDelay where
@ -412,7 +412,7 @@ instance ToJSON KeepAliveDelay where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | The timeout duration in 'Seconds' for a WebSocket connection. -- | The timeout duration in 'Seconds' for a WebSocket connection.
newtype WSConnectionInitTimeout = WSConnectionInitTimeout {unWSConnectionInitTimeout :: Numeric.NonNegative Seconds} newtype WSConnectionInitTimeout = WSConnectionInitTimeout {unWSConnectionInitTimeout :: Refined NonNegative Seconds}
deriving newtype (Show, Eq, Ord) deriving newtype (Show, Eq, Ord)
instance FromJSON WSConnectionInitTimeout where instance FromJSON WSConnectionInitTimeout where
@ -451,8 +451,8 @@ data ServeOptions impl = ServeOptions
soEnabledLogTypes :: HashSet (Logging.EngineLogType impl), soEnabledLogTypes :: HashSet (Logging.EngineLogType impl),
soLogLevel :: Logging.LogLevel, soLogLevel :: Logging.LogLevel,
soResponseInternalErrorsConfig :: ResponseInternalErrorsConfig, soResponseInternalErrorsConfig :: ResponseInternalErrorsConfig,
soEventsHttpPoolSize :: Numeric.PositiveInt, soEventsHttpPoolSize :: Refined Positive Int,
soEventsFetchInterval :: Numeric.NonNegative Milliseconds, soEventsFetchInterval :: Refined NonNegative Milliseconds,
soAsyncActionsFetchInterval :: OptionalInterval, soAsyncActionsFetchInterval :: OptionalInterval,
soEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions, soEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions,
soConnectionOptions :: WebSockets.ConnectionOptions, soConnectionOptions :: WebSockets.ConnectionOptions,
@ -462,9 +462,9 @@ data ServeOptions impl = ServeOptions
soSchemaPollInterval :: OptionalInterval, soSchemaPollInterval :: OptionalInterval,
-- | See note '$experimentalFeatures' -- | See note '$experimentalFeatures'
soExperimentalFeatures :: HashSet Server.Types.ExperimentalFeature, soExperimentalFeatures :: HashSet Server.Types.ExperimentalFeature,
soEventsFetchBatchSize :: Numeric.NonNegativeInt, soEventsFetchBatchSize :: Refined NonNegative Int,
soDevMode :: Bool, soDevMode :: Bool,
soGracefulShutdownTimeout :: Numeric.NonNegative Seconds, soGracefulShutdownTimeout :: Refined NonNegative Seconds,
soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout, soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout,
soEventingMode :: Server.Types.EventingMode, soEventingMode :: Server.Types.EventingMode,
-- | See note '$readOnlyMode' -- | See note '$readOnlyMode'

26
server/src-lib/Hasura/Server/Init/Env.hs
View File

@ -36,7 +36,6 @@ import Hasura.GraphQL.Schema.NamingCase qualified as NamingCase
import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init.Config qualified as Config import Hasura.Server.Init.Config qualified as Config
@ -45,6 +44,7 @@ import Hasura.Server.Types qualified as Server.Types
import Hasura.Server.Utils qualified as Utils import Hasura.Server.Utils qualified as Utils
import Hasura.Session qualified as Session import Hasura.Session qualified as Session
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import Refined (NonNegative, Positive, Refined, refineFail, unrefine)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -269,8 +269,8 @@ instance FromEnv Milliseconds where
instance FromEnv Config.OptionalInterval where instance FromEnv Config.OptionalInterval where
fromEnv x = do fromEnv x = do
i <- fromEnv @(Numeric.NonNegative Milliseconds) x i <- fromEnv @(Refined NonNegative Milliseconds) x
if Numeric.getNonNegative i == 0 if unrefine i == 0
then pure $ Config.Skip then pure $ Config.Skip
else pure $ Config.Interval i else pure $ Config.Interval i
@ -280,12 +280,12 @@ instance FromEnv Seconds where
instance FromEnv Config.WSConnectionInitTimeout where instance FromEnv Config.WSConnectionInitTimeout where
fromEnv s = do fromEnv s = do
seconds <- fromIntegral @_ @Seconds <$> fromEnv @Int s seconds <- fromIntegral @_ @Seconds <$> fromEnv @Int s
nonNegative <- maybeToEither "WebSocket Connection Timeout must not be negative" $ Numeric.mkNonNegative seconds nonNegative <- maybeToEither "WebSocket Connection Timeout must not be negative" $ refineFail seconds
pure $ Config.WSConnectionInitTimeout nonNegative pure $ Config.WSConnectionInitTimeout nonNegative
instance FromEnv Config.KeepAliveDelay where instance FromEnv Config.KeepAliveDelay where
fromEnv = fromEnv =
fmap Config.KeepAliveDelay . fromEnv @(Numeric.NonNegative Seconds) fmap Config.KeepAliveDelay . fromEnv @(Refined NonNegative Seconds)
instance FromEnv Auth.JWTConfig where instance FromEnv Auth.JWTConfig where
fromEnv = readJson fromEnv = readJson
@ -307,21 +307,17 @@ instance FromEnv Logging.LogLevel where
instance FromEnv Template.URLTemplate where instance FromEnv Template.URLTemplate where
fromEnv = Template.parseURLTemplate . Text.pack fromEnv = Template.parseURLTemplate . Text.pack
instance (Num a, Ord a, FromEnv a) => FromEnv (Numeric.NonNegative a) where instance (Num a, Ord a, FromEnv a) => FromEnv (Refined NonNegative a) where
fromEnv s = fromEnv s =
fmap (maybeToEither "Only expecting a non negative numeric") Numeric.mkNonNegative =<< fromEnv s fmap (maybeToEither "Only expecting a non negative numeric") refineFail =<< fromEnv s
instance FromEnv Numeric.NonNegativeInt where instance FromEnv (Refined NonNegative DiffTime) where
fromEnv s = fromEnv s =
maybeToEither "Only expecting a non negative integer" (Numeric.mkNonNegativeInt =<< readMaybe s) fmap (maybeToEither "Only expecting a non negative difftime") refineFail =<< (fromEnv @DiffTime s)
instance FromEnv Numeric.NonNegativeDiffTime where instance FromEnv (Refined Positive Int) where
fromEnv s = fromEnv s =
fmap (maybeToEither "Only expecting a non negative difftime") Numeric.mkNonNegativeDiffTime =<< (fromEnv @DiffTime s) maybeToEither "Only expecting a positive integer" (refineFail =<< readMaybe s)
instance FromEnv Numeric.PositiveInt where
fromEnv s =
maybeToEither "Only expecting a positive integer" (Numeric.mkPositiveInt =<< readMaybe s)
instance FromEnv Config.Port where instance FromEnv Config.Port where
fromEnv s = fromEnv s =

7
server/src-lib/Hasura/Server/SchemaUpdate.hs
View File

@ -27,8 +27,6 @@ import Hasura.Metadata.Class
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.DDL.Schema (runCacheRWT) import Hasura.RQL.DDL.Schema (runCacheRWT)
import Hasura.RQL.DDL.Schema.Catalog import Hasura.RQL.DDL.Schema.Catalog
import Hasura.RQL.Types.Numeric (NonNegative)
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.Run import Hasura.RQL.Types.Run
import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build import Hasura.RQL.Types.SchemaCache.Build
@ -44,6 +42,7 @@ import Hasura.Server.SchemaCacheRef
import Hasura.Server.Types import Hasura.Server.Types
import Hasura.Session import Hasura.Session
import Network.HTTP.Client qualified as HTTP import Network.HTTP.Client qualified as HTTP
import Refined (NonNegative, Refined, unrefine)
data ThreadType data ThreadType
= TTListener = TTListener
@ -151,14 +150,14 @@ startSchemaSyncListenerThread ::
Logger Hasura -> Logger Hasura ->
PG.PGPool -> PG.PGPool ->
InstanceId -> InstanceId ->
NonNegative Milliseconds -> Refined NonNegative Milliseconds ->
STM.TMVar MetadataResourceVersion -> STM.TMVar MetadataResourceVersion ->
ManagedT m (Immortal.Thread) ManagedT m (Immortal.Thread)
startSchemaSyncListenerThread logger pool instanceId interval metaVersionRef = do startSchemaSyncListenerThread logger pool instanceId interval metaVersionRef = do
-- Start listener thread -- Start listener thread
listenerThread <- listenerThread <-
C.forkManagedT "SchemeUpdate.listener" logger $ C.forkManagedT "SchemeUpdate.listener" logger $
listener logger pool metaVersionRef (Numeric.getNonNegative interval) listener logger pool metaVersionRef (unrefine interval)
logThreadStarted logger instanceId TTListener listenerThread logThreadStarted logger instanceId TTListener listenerThread
pure listenerThread pure listenerThread

118
server/src-test/Data/NumericSpec.hs
View File

@ -1,118 +0,0 @@
-- | basic tests on Numeric Types
module Data.NumericSpec
( spec,
)
where
--------------------------------------------------------------------------------
import Data.Aeson qualified as Aeson
import Data.Time qualified as Time
import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.RQL.Types.Numeric qualified as UUT
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Test.Hspec (Spec, shouldBe)
import Test.Hspec qualified as Hspec
import Test.Hspec.Hedgehog (MonadTest)
import Test.Hspec.Hedgehog qualified as Hedgehog
--------------------------------------------------------------------------------
spec :: Spec
spec = Hspec.describe "Numeric Spec" $ do
nonNegativeSpec
nonNegativeIntSpec
positiveIntSpec
nonNegativeDiffTimeSpec
--------------------------------------------------------------------------------
nonNegativeSpec :: Spec
nonNegativeSpec =
Hspec.describe "NonNegative" $ do
Hspec.it "only validates non negative integers" $ do
UUT.mkNonNegative @Integer 23 `shouldBe` Just (Numeric.unsafeNonNegative 23)
UUT.mkNonNegative @Integer (-23) `shouldBe` Nothing
Hspec.it "only validates non negative floats" $ do
UUT.mkNonNegative @Float 23 `shouldBe` Just (Numeric.unsafeNonNegative 23)
UUT.mkNonNegative @Float (-23) `shouldBe` Nothing
Hspec.it "FromJSON succeeds with a positive value" $ do
let result = Aeson.decode @(UUT.NonNegative Float) "100"
result `shouldBe` Just (Numeric.unsafeNonNegative 100)
Hspec.it "FromJSON fails with negative value" $ do
let result = Aeson.decode @(UUT.NonNegative Float) "-100"
result `shouldBe` Nothing
Hspec.it "JSON Round Tripping" $ Hedgehog.hedgehog do
expected :: Float <- Hedgehog.forAll $ Gen.float (Range.constant 0 9999)
jsonTripping (UUT.unsafeNonNegative expected)
nonNegativeIntSpec :: Spec
nonNegativeIntSpec =
Hspec.describe "NonNegativeInt" $ do
Hspec.it "only validates non negative integers" $ do
UUT.mkNonNegativeInt 23 `shouldBe` Just (Numeric.unsafeNonNegativeInt 23)
UUT.mkNonNegativeInt (-23) `shouldBe` Nothing
Hspec.it "FromJSON succeeds with a positive value" $ do
let result = Aeson.decode @UUT.NonNegativeInt "100"
result `shouldBe` Just (Numeric.unsafeNonNegativeInt 100)
Hspec.it "FromJSON fails with negative value" $ do
let result = Aeson.decode @UUT.NonNegativeInt "-100"
result `shouldBe` Nothing
Hspec.it "JSON Round Tripping" $ Hedgehog.hedgehog do
expected :: Int <- Hedgehog.forAll $ Gen.integral (Range.linear 0 9999)
jsonTripping (UUT.unsafeNonNegativeInt expected)
positiveIntSpec :: Spec
positiveIntSpec =
Hspec.describe "PositiveInt" $ do
Hspec.it "only validates positive integers" $ do
UUT.mkPositiveInt 23 `shouldBe` Just (Numeric.unsafePositiveInt 23)
UUT.mkPositiveInt (-23) `shouldBe` Nothing
UUT.mkPositiveInt (0) `shouldBe` Nothing
Hspec.it "FromJSON succeeds with a positive value" $ do
let result = Aeson.decode @UUT.PositiveInt "100"
result `shouldBe` Just (Numeric.unsafePositiveInt 100)
Hspec.it "FromJSON fails with negative value" $ do
let result = Aeson.decode @UUT.PositiveInt "-100"
result `shouldBe` Nothing
Hspec.it "FromJSON fails with zero" $ do
let result = Aeson.decode @UUT.PositiveInt "0"
result `shouldBe` Nothing
Hspec.it "JSON Round Tripping" $ Hedgehog.hedgehog do
expected :: Int <- Hedgehog.forAll $ Gen.integral (Range.linear 1 9999)
jsonTripping (UUT.unsafePositiveInt expected)
nonNegativeDiffTimeSpec :: Spec
nonNegativeDiffTimeSpec =
Hspec.describe "NonNegativeInt" $ do
Hspec.it "only validates non negative DiffTimes" $ do
UUT.mkNonNegativeDiffTime 23 `shouldBe` Just 23
UUT.mkNonNegativeDiffTime (-23) `shouldBe` Nothing
Hspec.it "FromJSON succeeds with a positive value" $ do
let result = Aeson.decode @UUT.NonNegativeDiffTime "100"
result `shouldBe` Just 100
Hspec.it "FromJSON fails with negative value" $ do
let result = Aeson.decode @UUT.NonNegativeDiffTime "-100"
result `shouldBe` Nothing
Hspec.it "JSON Round Tripping" $ Hedgehog.hedgehog do
expected :: DiffTime <- Hedgehog.forAll $ fmap Time.secondsToDiffTime $ Gen.integral (Range.linear 0 9999)
jsonTripping (UUT.unsafeNonNegativeDiffTime expected)
jsonTripping :: (MonadTest m, Show a, Eq a, Aeson.ToJSON a, Aeson.FromJSON a) => a -> m ()
jsonTripping a = Hedgehog.tripping a Aeson.encode Aeson.decode

31
server/src-test/Hasura/Server/Init/ArgSpec.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module Hasura.Server.Init.ArgSpec module Hasura.Server.Init.ArgSpec
( spec, ( spec,
) )
@ -7,6 +9,7 @@ where
import Control.Lens (preview, _Just) import Control.Lens (preview, _Just)
import Data.HashSet qualified as Set import Data.HashSet qualified as Set
import Data.Time (NominalDiffTime)
import Data.URL.Template qualified as Template import Data.URL.Template qualified as Template
import Database.PG.Query qualified as PG import Database.PG.Query qualified as PG
import Hasura.GraphQL.Execute.Subscription.Options qualified as ES import Hasura.GraphQL.Execute.Subscription.Options qualified as ES
@ -14,7 +17,6 @@ import Hasura.GraphQL.Schema.NamingCase qualified as NC
import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init qualified as UUT import Hasura.Server.Init qualified as UUT
@ -22,6 +24,7 @@ import Hasura.Server.Logging qualified as Logging
import Hasura.Server.Types qualified as Types import Hasura.Server.Types qualified as Types
import Hasura.Session qualified as Session import Hasura.Session qualified as Session
import Options.Applicative qualified as Opt import Options.Applicative qualified as Opt
import Refined (NonNegative, Positive, refineTH)
import Test.Hspec qualified as Hspec import Test.Hspec qualified as Hspec
{-# ANN module ("HLint: ignore Redundant ==" :: String) #-} {-# ANN module ("HLint: ignore Redundant ==" :: String) #-}
@ -419,12 +422,12 @@ serveParserSpec =
Opt.Success rawConnParams -> Opt.Success rawConnParams ->
rawConnParams rawConnParams
== UUT.ConnParamsRaw == UUT.ConnParamsRaw
{ rcpStripes = Just $ Numeric.unsafeNonNegativeInt 3, { rcpStripes = Just $$(refineTH @NonNegative @Int 3),
rcpConns = Just $ Numeric.unsafeNonNegativeInt 2, rcpConns = Just $$(refineTH @NonNegative @Int 2),
rcpIdleTime = Just $ Numeric.unsafeNonNegativeInt 40, rcpIdleTime = Just $$(refineTH @NonNegative @Int 40),
rcpConnLifetime = Just $ Numeric.unsafeNonNegative 400, rcpConnLifetime = Just $$(refineTH @NonNegative @NominalDiffTime 400),
rcpAllowPrepare = Just True, rcpAllowPrepare = Just True,
rcpPoolTimeout = Just (Numeric.unsafeNonNegative 45) rcpPoolTimeout = Just $$(refineTH @NonNegative @NominalDiffTime 45)
} }
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1402,7 +1405,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoEventsHttpPoolSize result `Hspec.shouldSatisfy` \case fmap UUT.rsoEventsHttpPoolSize result `Hspec.shouldSatisfy` \case
Opt.Success eventsHttpPoolSize -> eventsHttpPoolSize == Just (Numeric.unsafePositiveInt 50) Opt.Success eventsHttpPoolSize -> eventsHttpPoolSize == Just $$(refineTH @Positive @Int 50)
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1441,7 +1444,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoEventsFetchInterval result `Hspec.shouldSatisfy` \case fmap UUT.rsoEventsFetchInterval result `Hspec.shouldSatisfy` \case
Opt.Success eventsFetchInterval -> eventsFetchInterval == Just (Numeric.unsafeNonNegative 634) Opt.Success eventsFetchInterval -> eventsFetchInterval == Just $$(refineTH @NonNegative @Milliseconds 634)
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1493,7 +1496,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoAsyncActionsFetchInterval result `Hspec.shouldSatisfy` \case fmap UUT.rsoAsyncActionsFetchInterval result `Hspec.shouldSatisfy` \case
Opt.Success asyncActionsFetchInterval -> asyncActionsFetchInterval == Just (UUT.Interval $ Numeric.unsafeNonNegative 123) Opt.Success asyncActionsFetchInterval -> asyncActionsFetchInterval == Just (UUT.Interval $$(refineTH 123))
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1597,7 +1600,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoWebSocketKeepAlive result `Hspec.shouldSatisfy` \case fmap UUT.rsoWebSocketKeepAlive result `Hspec.shouldSatisfy` \case
Opt.Success webSocketKeepAlive -> webSocketKeepAlive == Just (UUT.KeepAliveDelay $ Numeric.unsafeNonNegative 8) Opt.Success webSocketKeepAlive -> webSocketKeepAlive == Just (UUT.KeepAliveDelay $$(refineTH 8))
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1714,7 +1717,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoSchemaPollInterval result `Hspec.shouldSatisfy` \case fmap UUT.rsoSchemaPollInterval result `Hspec.shouldSatisfy` \case
Opt.Success schemaPollInterval -> schemaPollInterval == Just (UUT.Interval $ Numeric.unsafeNonNegative 5432) Opt.Success schemaPollInterval -> schemaPollInterval == Just (UUT.Interval $$(refineTH 5432))
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1805,7 +1808,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoEventsFetchBatchSize result `Hspec.shouldSatisfy` \case fmap UUT.rsoEventsFetchBatchSize result `Hspec.shouldSatisfy` \case
Opt.Success eventsFetchBatchSize -> eventsFetchBatchSize == Just (Numeric.unsafeNonNegativeInt 40) Opt.Success eventsFetchBatchSize -> eventsFetchBatchSize == Just $$(refineTH @NonNegative @Int 40)
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1844,7 +1847,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoGracefulShutdownTimeout result `Hspec.shouldSatisfy` \case fmap UUT.rsoGracefulShutdownTimeout result `Hspec.shouldSatisfy` \case
Opt.Success gracefulShutdownTimeout -> gracefulShutdownTimeout == Just (Numeric.unsafeNonNegative 52) Opt.Success gracefulShutdownTimeout -> gracefulShutdownTimeout == Just $$(refineTH @NonNegative @Seconds 52)
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False
@ -1896,7 +1899,7 @@ serveParserSpec =
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
fmap UUT.rsoWebSocketConnectionInitTimeout result `Hspec.shouldSatisfy` \case fmap UUT.rsoWebSocketConnectionInitTimeout result `Hspec.shouldSatisfy` \case
Opt.Success webSocketConnectionInitTimeout -> webSocketConnectionInitTimeout == Just (UUT.WSConnectionInitTimeout (Numeric.unsafeNonNegative 34)) Opt.Success webSocketConnectionInitTimeout -> webSocketConnectionInitTimeout == Just (UUT.WSConnectionInitTimeout $$(refineTH 34))
Opt.Failure _pf -> False Opt.Failure _pf -> False
Opt.CompletionInvoked _cr -> False Opt.CompletionInvoked _cr -> False

87
server/src-test/Hasura/Server/InitSpec.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module Hasura.Server.InitSpec module Hasura.Server.InitSpec
( spec, ( spec,
) )
@ -7,6 +9,7 @@ where
import Data.HashSet qualified as Set import Data.HashSet qualified as Set
import Data.Monoid (All (..)) import Data.Monoid (All (..))
import Data.Time (NominalDiffTime)
import Database.PG.Query qualified as Query import Database.PG.Query qualified as Query
import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options
import Hasura.GraphQL.Schema.NamingCase qualified as NamingCase import Hasura.GraphQL.Schema.NamingCase qualified as NamingCase
@ -14,7 +17,6 @@ import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging (Hasura) import Hasura.Logging (Hasura)
import Hasura.Logging qualified as Logging import Hasura.Logging qualified as Logging
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.SQL.Types qualified as MonadTx import Hasura.SQL.Types qualified as MonadTx
import Hasura.Server.Auth qualified as Auth import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors import Hasura.Server.Cors qualified as Cors
@ -23,6 +25,7 @@ import Hasura.Server.Logging qualified as Logging
import Hasura.Server.Types qualified as Types import Hasura.Server.Types qualified as Types
import Hasura.Session qualified as UUT import Hasura.Session qualified as UUT
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Refined (NonNegative, Positive, refineTH, unrefine)
import Test.Hspec qualified as Hspec import Test.Hspec qualified as Hspec
{-# ANN module ("HLint: ignore Redundant ==" :: String) #-} {-# ANN module ("HLint: ignore Redundant ==" :: String) #-}
@ -166,11 +169,11 @@ mkServeOptionsSpec =
fmap UUT.soConnParams result fmap UUT.soConnParams result
`Hspec.shouldBe` Right `Hspec.shouldBe` Right
( Query.ConnParams ( Query.ConnParams
{ Query.cpStripes = Numeric.getNonNegativeInt $ UUT._default UUT.pgStripesOption, { Query.cpStripes = unrefine $ UUT._default UUT.pgStripesOption,
Query.cpConns = Numeric.getNonNegativeInt $ UUT._default UUT.pgConnsOption, Query.cpConns = unrefine $ UUT._default UUT.pgConnsOption,
Query.cpIdleTime = Numeric.getNonNegativeInt $ UUT._default UUT.pgTimeoutOption, Query.cpIdleTime = unrefine $ UUT._default UUT.pgTimeoutOption,
Query.cpAllowPrepare = UUT._default UUT.pgUsePreparedStatementsOption, Query.cpAllowPrepare = UUT._default UUT.pgUsePreparedStatementsOption,
Query.cpMbLifetime = Just $ Numeric.getNonNegative $ UUT._default UUT.pgConnLifetimeOption, Query.cpMbLifetime = Just $ unrefine $ UUT._default UUT.pgConnLifetimeOption,
Query.cpTimeout = Nothing, Query.cpTimeout = Nothing,
Query.cpCancel = True Query.cpCancel = True
} }
@ -210,12 +213,12 @@ mkServeOptionsSpec =
emptyServeOptionsRaw emptyServeOptionsRaw
{ UUT.rsoConnParams = { UUT.rsoConnParams =
UUT.ConnParamsRaw UUT.ConnParamsRaw
{ rcpStripes = Just (Numeric.unsafeNonNegativeInt 2), { rcpStripes = Just $$(refineTH @NonNegative @Int 2),
rcpConns = Just (Numeric.unsafeNonNegativeInt 3), rcpConns = Just $$(refineTH @NonNegative @Int 3),
rcpIdleTime = Just (Numeric.unsafeNonNegativeInt 4), rcpIdleTime = Just $$(refineTH @NonNegative @Int 4),
rcpConnLifetime = Just (Numeric.unsafeNonNegative 5), rcpConnLifetime = Just $$(refineTH @NonNegative @NominalDiffTime 5),
rcpAllowPrepare = Just True, rcpAllowPrepare = Just True,
rcpPoolTimeout = Just (Numeric.unsafeNonNegative 6) rcpPoolTimeout = Just $$(refineTH @NonNegative @NominalDiffTime 6)
} }
} }
-- When -- When
@ -656,8 +659,8 @@ mkServeOptionsSpec =
fmap UUT.soLiveQueryOpts result fmap UUT.soLiveQueryOpts result
`Hspec.shouldBe` Right `Hspec.shouldBe` Right
( Subscription.Options.SubscriptionsOptions ( Subscription.Options.SubscriptionsOptions
{ _lqoRefetchInterval = Subscription.Options.RefetchInterval 2, { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 2),
_lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 200) _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 200)
} }
) )
@ -679,8 +682,8 @@ mkServeOptionsSpec =
fmap UUT.soLiveQueryOpts result fmap UUT.soLiveQueryOpts result
`Hspec.shouldBe` Right `Hspec.shouldBe` Right
( Subscription.Options.SubscriptionsOptions ( Subscription.Options.SubscriptionsOptions
{ _lqoRefetchInterval = Subscription.Options.RefetchInterval 3, { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 3),
_lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 300) _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 300)
} }
) )
@ -715,8 +718,8 @@ mkServeOptionsSpec =
fmap UUT.soStreamingQueryOpts result fmap UUT.soStreamingQueryOpts result
`Hspec.shouldBe` Right `Hspec.shouldBe` Right
( Subscription.Options.SubscriptionsOptions ( Subscription.Options.SubscriptionsOptions
{ _lqoRefetchInterval = Subscription.Options.RefetchInterval 2, { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 2),
_lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 200) _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 200)
} }
) )
@ -738,8 +741,8 @@ mkServeOptionsSpec =
fmap UUT.soStreamingQueryOpts result fmap UUT.soStreamingQueryOpts result
`Hspec.shouldBe` Right `Hspec.shouldBe` Right
( Subscription.Options.SubscriptionsOptions ( Subscription.Options.SubscriptionsOptions
{ _lqoRefetchInterval = Subscription.Options.RefetchInterval 3, { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 3),
_lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 300) _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 300)
} }
) )
@ -923,17 +926,17 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soEventsHttpPoolSize result `Hspec.shouldBe` Right (Numeric.unsafePositiveInt 200) fmap UUT.soEventsHttpPoolSize result `Hspec.shouldBe` Right $$(refineTH @Positive @Int 200)
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsHttpPoolSize = Just (Numeric.unsafePositiveInt 300)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsHttpPoolSize = Just $$(refineTH @Positive @Int 300)}
-- When -- When
env = [(UUT._envVar UUT.graphqlEventsHttpPoolSizeOption, "200")] env = [(UUT._envVar UUT.graphqlEventsHttpPoolSizeOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soEventsHttpPoolSize result `Hspec.shouldBe` Right (Numeric.unsafePositiveInt 300) fmap UUT.soEventsHttpPoolSize result `Hspec.shouldBe` Right $$(refineTH @Positive @Int 300)
Hspec.describe "soEventsFetchInterval" $ do Hspec.describe "soEventsFetchInterval" $ do
Hspec.it "Default == 1" $ do Hspec.it "Default == 1" $ do
@ -954,17 +957,17 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soEventsFetchInterval result `Hspec.shouldBe` Right (Numeric.unsafeNonNegative $ 200) fmap UUT.soEventsFetchInterval result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Milliseconds 200)
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchInterval = Just $ Numeric.unsafeNonNegative 300} rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchInterval = Just $$(refineTH @NonNegative @Milliseconds 300)}
-- When -- When
env = [(UUT._envVar UUT.graphqlEventsFetchIntervalOption, "200")] env = [(UUT._envVar UUT.graphqlEventsFetchIntervalOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soEventsFetchInterval result `Hspec.shouldBe` Right (Numeric.unsafeNonNegative 300) fmap UUT.soEventsFetchInterval result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Milliseconds 300)
Hspec.describe "soAsyncActionsFetchInterval" $ do Hspec.describe "soAsyncActionsFetchInterval" $ do
Hspec.it "Default == 1000" $ do Hspec.it "Default == 1000" $ do
@ -985,7 +988,7 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soAsyncActionsFetchInterval result `Hspec.shouldBe` Right (UUT.Interval $ Numeric.unsafeNonNegative 200) fmap UUT.soAsyncActionsFetchInterval result `Hspec.shouldBe` Right (UUT.Interval $$(refineTH 200))
Hspec.it "0 == 'Skip'" $ do Hspec.it "0 == 'Skip'" $ do
let -- Given let -- Given
@ -999,13 +1002,13 @@ mkServeOptionsSpec =
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoAsyncActionsFetchInterval = Just (UUT.Interval $ Numeric.unsafeNonNegative 300)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoAsyncActionsFetchInterval = Just (UUT.Interval $$(refineTH 300))}
-- When -- When
env = [(UUT._envVar UUT.asyncActionsFetchIntervalOption, "200")] env = [(UUT._envVar UUT.asyncActionsFetchIntervalOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap UUT.soAsyncActionsFetchInterval result `Hspec.shouldBe` Right (UUT.Interval $ Numeric.unsafeNonNegative 300) fmap UUT.soAsyncActionsFetchInterval result `Hspec.shouldBe` Right (UUT.Interval $$(refineTH 300))
Hspec.describe "soEnableRemoteSchemaPermissions" $ do Hspec.describe "soEnableRemoteSchemaPermissions" $ do
Hspec.it "Default == False" $ do Hspec.it "Default == False" $ do
@ -1090,17 +1093,17 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soWebSocketKeepAlive) result `Hspec.shouldBe` Right (UUT.KeepAliveDelay $ Numeric.unsafeNonNegative 10) fmap (UUT.soWebSocketKeepAlive) result `Hspec.shouldBe` Right (UUT.KeepAliveDelay $$(refineTH 10))
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoWebSocketKeepAlive = Just (UUT.KeepAliveDelay $ Numeric.unsafeNonNegative 20)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoWebSocketKeepAlive = Just (UUT.KeepAliveDelay $$(refineTH 20))}
-- When -- When
env = [(UUT._envVar UUT.webSocketKeepAliveOption, "10")] env = [(UUT._envVar UUT.webSocketKeepAliveOption, "10")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soWebSocketKeepAlive) result `Hspec.shouldBe` Right (UUT.KeepAliveDelay $ Numeric.unsafeNonNegative 20) fmap (UUT.soWebSocketKeepAlive) result `Hspec.shouldBe` Right (UUT.KeepAliveDelay $$(refineTH 20))
Hspec.describe "soInferFunctionPermissions" $ do Hspec.describe "soInferFunctionPermissions" $ do
Hspec.it "Default == FunctionPermissionsInferred" $ do Hspec.it "Default == FunctionPermissionsInferred" $ do
@ -1183,7 +1186,7 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soSchemaPollInterval) result `Hspec.shouldBe` Right (UUT.Interval $ Numeric.unsafeNonNegative 2000) fmap (UUT.soSchemaPollInterval) result `Hspec.shouldBe` Right (UUT.Interval $$(refineTH 2000))
Hspec.it "0 == Skip" $ do Hspec.it "0 == Skip" $ do
let -- Given let -- Given
@ -1197,13 +1200,13 @@ mkServeOptionsSpec =
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoSchemaPollInterval = Just (UUT.Interval $ Numeric.unsafeNonNegative 3000)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoSchemaPollInterval = Just (UUT.Interval $$(refineTH 3000))}
-- When -- When
env = [(UUT._envVar UUT.schemaPollIntervalOption, "2000")] env = [(UUT._envVar UUT.schemaPollIntervalOption, "2000")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soSchemaPollInterval) result `Hspec.shouldBe` Right (UUT.Interval $ Numeric.unsafeNonNegative 3000) fmap (UUT.soSchemaPollInterval) result `Hspec.shouldBe` Right (UUT.Interval $$(refineTH 3000))
Hspec.describe "soExperimentalFeatures" $ do Hspec.describe "soExperimentalFeatures" $ do
Hspec.it "Default == mempty" $ do Hspec.it "Default == mempty" $ do
@ -1249,17 +1252,17 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soEventsFetchBatchSize) result `Hspec.shouldBe` Right (Numeric.unsafeNonNegativeInt 200) fmap (UUT.soEventsFetchBatchSize) result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Int 200)
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchBatchSize = Just (Numeric.unsafeNonNegativeInt 300)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchBatchSize = Just $$(refineTH @NonNegative @Int 300)}
-- When -- When
env = [(UUT._envVar UUT.eventsFetchBatchSizeOption, "200")] env = [(UUT._envVar UUT.eventsFetchBatchSizeOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soEventsFetchBatchSize) result `Hspec.shouldBe` Right (Numeric.unsafeNonNegativeInt 300) fmap (UUT.soEventsFetchBatchSize) result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Int 300)
Hspec.describe "soGracefulShutdownTimeout" $ do Hspec.describe "soGracefulShutdownTimeout" $ do
Hspec.it "Default == 60" $ do Hspec.it "Default == 60" $ do
@ -1282,17 +1285,17 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soGracefulShutdownTimeout) result `Hspec.shouldBe` Right (Numeric.unsafeNonNegative 200) fmap (UUT.soGracefulShutdownTimeout) result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Seconds 200)
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = emptyServeOptionsRaw {UUT.rsoGracefulShutdownTimeout = Just (Numeric.unsafeNonNegative 300)} rawServeOptions = emptyServeOptionsRaw {UUT.rsoGracefulShutdownTimeout = Just $$(refineTH @NonNegative @Seconds 300)}
-- When -- When
env = [(UUT._envVar UUT.gracefulShutdownOption, "200")] env = [(UUT._envVar UUT.gracefulShutdownOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soGracefulShutdownTimeout) result `Hspec.shouldBe` Right (Numeric.unsafeNonNegative 300) fmap (UUT.soGracefulShutdownTimeout) result `Hspec.shouldBe` Right $$(refineTH @NonNegative @Seconds 300)
Hspec.describe "soWebSocketConnectionInitTimeout" $ do Hspec.describe "soWebSocketConnectionInitTimeout" $ do
Hspec.it "Default == 3" $ do Hspec.it "Default == 3" $ do
@ -1313,20 +1316,20 @@ mkServeOptionsSpec =
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soWebSocketConnectionInitTimeout) result `Hspec.shouldBe` Right (UUT.WSConnectionInitTimeout (Numeric.unsafeNonNegative 200)) fmap (UUT.soWebSocketConnectionInitTimeout) result `Hspec.shouldBe` Right (UUT.WSConnectionInitTimeout $$(refineTH @NonNegative @Seconds 200))
Hspec.it "Arg > Env" $ do Hspec.it "Arg > Env" $ do
let -- Given let -- Given
rawServeOptions = rawServeOptions =
emptyServeOptionsRaw emptyServeOptionsRaw
{ UUT.rsoWebSocketConnectionInitTimeout = Just (UUT.WSConnectionInitTimeout (Numeric.unsafeNonNegative 300)) { UUT.rsoWebSocketConnectionInitTimeout = Just (UUT.WSConnectionInitTimeout $$(refineTH @NonNegative @Seconds 300))
} }
-- When -- When
env = [(UUT._envVar UUT.webSocketConnectionInitTimeoutOption, "200")] env = [(UUT._envVar UUT.webSocketConnectionInitTimeoutOption, "200")]
-- Then -- Then
result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions) result = UUT.runWithEnv env (UUT.mkServeOptions @Hasura rawServeOptions)
fmap (UUT.soWebSocketConnectionInitTimeout) result `Hspec.shouldBe` Right (UUT.WSConnectionInitTimeout (Numeric.unsafeNonNegative 300)) fmap (UUT.soWebSocketConnectionInitTimeout) result `Hspec.shouldBe` Right (UUT.WSConnectionInitTimeout $$(refineTH @NonNegative @Seconds 300))
Hspec.describe "soEnableMetadataQueryLoggingEnv" $ do Hspec.describe "soEnableMetadataQueryLoggingEnv" $ do
Hspec.it "Default == MetadataQueryLoggingDisabled" $ do Hspec.it "Default == MetadataQueryLoggingDisabled" $ do

9
server/tests-hspec/Harness/Constants.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Constant configurations used throughout the test suite. -- | Constant configurations used throughout the test suite.
module Harness.Constants module Harness.Constants
@ -48,7 +49,6 @@ import Hasura.GraphQL.Execute.Subscription.Options qualified as ES
import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as L import Hasura.Logging qualified as L
import Hasura.Prelude import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
import Hasura.Server.Cors (CorsConfig (CCAllowAll)) import Hasura.Server.Cors (CorsConfig (CCAllowAll))
import Hasura.Server.Init import Hasura.Server.Init
( API (CONFIG, DEVELOPER, GRAPHQL, METADATA), ( API (CONFIG, DEVELOPER, GRAPHQL, METADATA),
@ -65,6 +65,7 @@ import Hasura.Server.Types
ReadOnlyMode (ReadOnlyModeDisabled), ReadOnlyMode (ReadOnlyModeDisabled),
) )
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Refined (refineTH)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -268,11 +269,11 @@ serveOptions =
soInferFunctionPermissions = Options.InferFunctionPermissions, soInferFunctionPermissions = Options.InferFunctionPermissions,
soEnableMaintenanceMode = MaintenanceModeDisabled, soEnableMaintenanceMode = MaintenanceModeDisabled,
-- MUST be disabled to be able to modify schema. -- MUST be disabled to be able to modify schema.
soSchemaPollInterval = Interval (Numeric.unsafeNonNegative 10), soSchemaPollInterval = Interval $$(refineTH 10),
soExperimentalFeatures = Set.singleton EFStreamingSubscriptions, soExperimentalFeatures = Set.singleton EFStreamingSubscriptions,
soEventsFetchBatchSize = Numeric.unsafeNonNegativeInt 1, soEventsFetchBatchSize = $$(refineTH 1),
soDevMode = True, soDevMode = True,
soGracefulShutdownTimeout = Numeric.unsafeNonNegative 0, -- Don't wait to shutdown. soGracefulShutdownTimeout = $$(refineTH 0), -- Don't wait to shutdown.
soWebSocketConnectionInitTimeout = Init._default Init.webSocketConnectionInitTimeoutOption, soWebSocketConnectionInitTimeout = Init._default Init.webSocketConnectionInitTimeoutOption,
soEventingMode = EventingEnabled, soEventingMode = EventingEnabled,
soReadOnlyMode = ReadOnlyModeDisabled, soReadOnlyMode = ReadOnlyModeDisabled,